Theory CZH_ECAT_Introduction
sectionβΉIntroductionβΊ
theory CZH_ECAT_Introduction
imports CZH_Foundations.CZH_DG_Introduction
begin
subsectionβΉBackgroundβΊ
textβΉ
This article provides a
formalization of the elementary theory of 1-categories without
an additional structure. For further information see
chapter Introduction in the first installment of
this work: βΉCategory Theory for ZFC in HOL I: FoundationsβΊ.
βΊ
subsectionβΉPreliminariesβΊ
named_theorems cat_op_simps
named_theorems cat_op_intros
named_theorems cat_cs_simps
named_theorems cat_cs_intros
named_theorems cat_arrow_cs_intros
subsectionβΉCS setup for foundationsβΊ
lemmas (in π΅) [cat_cs_intros] =
π΅_Ξ²
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Category
sectionβΉCategoryβΊ
theory CZH_ECAT_Category
imports
CZH_ECAT_Introduction
CZH_Foundations.CZH_SMC_Semicategory
begin
subsectionβΉBackgroundβΊ
lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros
definition CId :: V
where [dg_field_simps]: "CId = 5β©β"
subsubsectionβΉSlicingβΊ
definition cat_smc :: "V β V"
where "cat_smc β = [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Domβ¦, ββ¦Codβ¦, ββ¦Compβ¦]β©β"
textβΉComponents.βΊ
lemma cat_smc_components[slicing_simps]:
shows "cat_smc ββ¦Objβ¦ = ββ¦Objβ¦"
and "cat_smc ββ¦Arrβ¦ = ββ¦Arrβ¦"
and "cat_smc ββ¦Domβ¦ = ββ¦Domβ¦"
and "cat_smc ββ¦Codβ¦ = ββ¦Codβ¦"
and "cat_smc ββ¦Compβ¦ = ββ¦Compβ¦"
unfolding cat_smc_def dg_field_simps by (auto simp: nat_omega_simps)
textβΉRegular definitions.βΊ
lemma cat_smc_is_arr[slicing_simps]:
"f : a β¦βcat_smc ββ b β· f : a β¦βββ b"
unfolding is_arr_def slicing_simps ..
lemmas [slicing_intros] = cat_smc_is_arr[THEN iffD2]
lemma cat_smc_composable_arrs[slicing_simps]:
"composable_arrs (cat_smc β) = composable_arrs β"
unfolding composable_arrs_def slicing_simps ..
lemma cat_smc_is_monic_arr[slicing_simps]:
"f : a β¦β©mβ©oβ©nβcat_smc ββ b β· f : a β¦β©mβ©oβ©nβββ b"
unfolding is_monic_arr_def slicing_simps ..
lemmas [slicing_intros] = cat_smc_is_monic_arr[THEN iffD2]
lemma cat_smc_is_epic_arr[slicing_simps]:
"f : a β¦β©eβ©pβ©iβcat_smc ββ b β· f : a β¦β©eβ©pβ©iβββ b"
unfolding is_epic_arr_def slicing_simps op_smc_def
by (simp add: nat_omega_simps)
lemmas [slicing_intros] = cat_smc_is_epic_arr[THEN iffD2]
lemma cat_smc_is_idem_arr[slicing_simps]:
"f : β¦β©iβ©dβ©eβcat_smc ββ b β· f : β¦β©iβ©dβ©eβββ b"
unfolding is_idem_arr_def slicing_simps ..
lemmas [slicing_intros] = cat_smc_is_idem_arr[THEN iffD2]
lemma cat_smc_obj_terminal[slicing_simps]:
"obj_terminal (cat_smc β) a β· obj_terminal β a"
unfolding obj_terminal_def slicing_simps ..
lemmas [slicing_intros] = cat_smc_obj_terminal[THEN iffD2]
lemma cat_smc_obj_intial[slicing_simps]:
"obj_initial (cat_smc β) a β· obj_initial β a"
unfolding obj_initial_def obj_terminal_def
unfolding smc_op_simps slicing_simps
..
lemmas [slicing_intros] = cat_smc_obj_intial[THEN iffD2]
lemma cat_smc_obj_null[slicing_simps]:
"obj_null (cat_smc β) a β· obj_null β a"
unfolding obj_null_def slicing_simps smc_op_simps ..
lemmas [slicing_intros] = cat_smc_obj_null[THEN iffD2]
lemma cat_smc_is_zero_arr[slicing_simps]:
"f : a β¦β©0βcat_smc ββ b β· f : a β¦β©0βββ b"
unfolding is_zero_arr_def slicing_simps ..
lemmas [slicing_intros] = cat_smc_is_zero_arr[THEN iffD2]
subsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The definition of a category that is used in this work is
is similar to the definition that can be found in Chapter I-2 in
\cite{mac_lane_categories_2010}. The amendments to the definitions that are
associated with size have already been explained in the previous
installment of this body of work.
βΊ
locale category = π΅ Ξ± + vfsequence β + CId: vsv βΉββ¦CIdβ¦βΊ for Ξ± β +
assumes cat_length[cat_cs_simps]: "vcard β = 6β©β"
and cat_semicategory[slicing_intros]: "semicategory Ξ± (cat_smc β)"
and cat_CId_vdomain[cat_cs_simps]: "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and cat_CId_is_arr[cat_cs_intros]: "a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and cat_CId_left_left[cat_cs_simps]:
"f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and cat_CId_right_left[cat_cs_simps]:
"f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
lemmas [cat_cs_simps] =
category.cat_length
category.cat_CId_vdomain
category.cat_CId_left_left
category.cat_CId_right_left
lemma (in category) cat_CId_is_arr'[cat_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦" and "b = a" and "c = a" and "β' = β"
shows "ββ¦CIdβ¦β¦aβ¦ : b β¦ββ'β c"
using assms(1) unfolding assms(2-4) by (rule cat_CId_is_arr)
lemmas [cat_cs_intros] = category.cat_CId_is_arr'
lemma (in category) cat_CId_is_arr''[cat_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦" and "f = ββ¦CIdβ¦β¦aβ¦"
shows "f : a β¦βββ a"
using assms(1) unfolding assms(2) by (cs_concl cs_intro: cat_cs_intros)
lemmas [cat_cs_intros] = category.cat_CId_is_arr''
lemmas [slicing_intros] = category.cat_semicategory
lemma (in category) cat_CId_vrange: "ββ©β (ββ¦CIdβ¦) ββ©β ββ¦Arrβ¦"
proof
fix f assume "f ββ©β ββ©β (ββ¦CIdβ¦)"
with cat_CId_vdomain obtain a where "a ββ©β ββ¦Objβ¦" and "f = ββ¦CIdβ¦β¦aβ¦"
by (auto elim!: CId.vrange_atE)
with cat_CId_is_arr show "f ββ©β ββ¦Arrβ¦" by auto
qed
textβΉRules.βΊ
lemma (in category) category_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "category Ξ±' β"
unfolding assms by (rule category_axioms)
mk_ide rf category_def[unfolded category_axioms_def]
|intro categoryI|
|dest categoryD[dest]|
|elim categoryE[elim]|
lemma categoryI':
assumes "π΅ Ξ±"
and "vfsequence β"
and "vcard β = 6β©β"
and "vsv (ββ¦Domβ¦)"
and "vsv (ββ¦Codβ¦)"
and "vsv (ββ¦Compβ¦)"
and "vsv (ββ¦CIdβ¦)"
and "πβ©β (ββ¦Domβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Domβ¦) ββ©β ββ¦Objβ¦"
and "πβ©β (ββ¦Codβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Codβ¦) ββ©β ββ¦Objβ¦"
and "βgf. gf ββ©β πβ©β (ββ¦Compβ¦) β·
(βg f b c a. gf = [g, f]β©β β§ g : b β¦βββ c β§ f : a β¦βββ b)"
and "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and "βb c g a f. β¦ g : b β¦βββ c; f : a β¦βββ b β§ βΉ g ββ©Aβββ f : a β¦βββ c"
and "βc d h b g a f. β¦ h : c β¦βββ d; g : b β¦βββ c; f : a β¦βββ b β§ βΉ
(h ββ©Aβββ g) ββ©Aβββ f = h ββ©Aβββ (g ββ©Aβββ f)"
and "βa. a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and "βa b f. f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and "βb c f. f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
and "ββ¦Objβ¦ ββ©β Vset Ξ±"
and "βA B. β¦ A ββ©β ββ¦Objβ¦; B ββ©β ββ¦Objβ¦; A ββ©β Vset Ξ±; B ββ©β Vset Ξ± β§ βΉ
(ββ©βaββ©βA. ββ©βbββ©βB. Hom β a b) ββ©β Vset Ξ±"
shows "category Ξ± β"
by (intro categoryI semicategoryI', unfold cat_smc_components slicing_simps)
(simp_all add: assms smc_dg_def nat_omega_simps cat_smc_def)
lemma categoryD':
assumes "category Ξ± β"
shows "π΅ Ξ±"
and "vfsequence β"
and "vcard β = 6β©β"
and "vsv (ββ¦Domβ¦)"
and "vsv (ββ¦Codβ¦)"
and "vsv (ββ¦Compβ¦)"
and "vsv (ββ¦CIdβ¦)"
and "πβ©β (ββ¦Domβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Domβ¦) ββ©β ββ¦Objβ¦"
and "πβ©β (ββ¦Codβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Codβ¦) ββ©β ββ¦Objβ¦"
and "βgf. gf ββ©β πβ©β (ββ¦Compβ¦) β·
(βg f b c a. gf = [g, f]β©β β§ g : b β¦βββ c β§ f : a β¦βββ b)"
and "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and "βb c g a f. β¦ g : b β¦βββ c; f : a β¦βββ b β§ βΉ g ββ©Aβββ f : a β¦βββ c"
and "βc d h b g a f. β¦ h : c β¦βββ d; g : b β¦βββ c; f : a β¦βββ b β§ βΉ
(h ββ©Aβββ g) ββ©Aβββ f = h ββ©Aβββ (g ββ©Aβββ f)"
and "βa. a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and "βa b f. f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and "βb c f. f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
and "ββ¦Objβ¦ ββ©β Vset Ξ±"
and "βA B. β¦ A ββ©β ββ¦Objβ¦; B ββ©β ββ¦Objβ¦; A ββ©β Vset Ξ±; B ββ©β Vset Ξ± β§ βΉ
(ββ©βaββ©βA. ββ©βbββ©βB. Hom β a b) ββ©β Vset Ξ±"
by
(
simp_all add:
categoryD(2-9)[OF assms]
semicategoryD'[OF categoryD(5)[OF assms], unfolded slicing_simps]
)
lemma categoryE':
assumes "category Ξ± β"
obtains "π΅ Ξ±"
and "vfsequence β"
and "vcard β = 6β©β"
and "vsv (ββ¦Domβ¦)"
and "vsv (ββ¦Codβ¦)"
and "vsv (ββ¦Compβ¦)"
and "vsv (ββ¦CIdβ¦)"
and "πβ©β (ββ¦Domβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Domβ¦) ββ©β ββ¦Objβ¦"
and "πβ©β (ββ¦Codβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Codβ¦) ββ©β ββ¦Objβ¦"
and "βgf. gf ββ©β πβ©β (ββ¦Compβ¦) β·
(βg f b c a. gf = [g, f]β©β β§ g : b β¦βββ c β§ f : a β¦βββ b)"
and "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and "βb c g a f. β¦ g : b β¦βββ c; f : a β¦βββ b β§ βΉ g ββ©Aβββ f : a β¦βββ c"
and "βc d h b g a f. β¦ h : c β¦βββ d; g : b β¦βββ c; f : a β¦βββ b β§ βΉ
(h ββ©Aβββ g) ββ©Aβββ f = h ββ©Aβββ (g ββ©Aβββ f)"
and "βa. a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and "βa b f. f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and "βb c f. f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
and "ββ¦Objβ¦ ββ©β Vset Ξ±"
and "βA B. β¦ A ββ©β ββ¦Objβ¦; B ββ©β ββ¦Objβ¦; A ββ©β Vset Ξ±; B ββ©β Vset Ξ± β§ βΉ
(ββ©βaββ©βA. ββ©βbββ©βB. Hom β a b) ββ©β Vset Ξ±"
using assms by (simp add: categoryD')
textβΉSlicing.βΊ
context category
begin
interpretation smc: semicategory Ξ± βΉcat_smc ββΊ by (rule cat_semicategory)
sublocale Dom: vsv βΉββ¦Domβ¦βΊ
by (rule smc.Dom.vsv_axioms[unfolded slicing_simps])
sublocale Cod: vsv βΉββ¦Codβ¦βΊ
by (rule smc.Cod.vsv_axioms[unfolded slicing_simps])
sublocale Comp: pbinop βΉββ¦Arrβ¦βΊ βΉββ¦Compβ¦βΊ
by (rule smc.Comp.pbinop_axioms[unfolded slicing_simps])
lemmas_with [unfolded slicing_simps]:
cat_Dom_vdomain[cat_cs_simps] = smc.smc_Dom_vdomain
and cat_Dom_vrange = smc.smc_Dom_vrange
and cat_Cod_vdomain[cat_cs_simps] = smc.smc_Cod_vdomain
and cat_Cod_vrange = smc.smc_Cod_vrange
and cat_Obj_vsubset_Vset = smc.smc_Obj_vsubset_Vset
and cat_Hom_vifunion_in_Vset[cat_cs_intros] = smc.smc_Hom_vifunion_in_Vset
and cat_Obj_if_Dom_vrange = smc.smc_Obj_if_Dom_vrange
and cat_Obj_if_Cod_vrange = smc.smc_Obj_if_Cod_vrange
and cat_is_arrD = smc.smc_is_arrD
and cat_is_arrE[elim] = smc.smc_is_arrE
and cat_in_ArrE[elim] = smc.smc_in_ArrE
and cat_Hom_in_Vset[cat_cs_intros] = smc.smc_Hom_in_Vset
and cat_Arr_vsubset_Vset = smc.smc_Arr_vsubset_Vset
and cat_Dom_vsubset_Vset = smc.smc_Dom_vsubset_Vset
and cat_Cod_vsubset_Vset = smc.smc_Cod_vsubset_Vset
and cat_Obj_in_Vset = smc.smc_Obj_in_Vset
and cat_in_Obj_in_Vset[cat_cs_intros] = smc.smc_in_Obj_in_Vset
and cat_Arr_in_Vset = smc.smc_Arr_in_Vset
and cat_in_Arr_in_Vset[cat_cs_intros] = smc.smc_in_Arr_in_Vset
and cat_Dom_in_Vset = smc.smc_Dom_in_Vset
and cat_Cod_in_Vset = smc.smc_Cod_in_Vset
and cat_semicategory_if_ge_Limit = smc.smc_semicategory_if_ge_Limit
and cat_Dom_app_in_Obj = smc.smc_Dom_app_in_Obj
and cat_Cod_app_in_Obj = smc.smc_Cod_app_in_Obj
and cat_Arr_vempty_if_Obj_vempty = smc.smc_Arr_vempty_if_Obj_vempty
and cat_Dom_vempty_if_Arr_vempty = smc.smc_Dom_vempty_if_Arr_vempty
and cat_Cod_vempty_if_Arr_vempty = smc.smc_Cod_vempty_if_Arr_vempty
lemmas [cat_cs_intros] = cat_is_arrD(2,3)
lemmas_with [unfolded slicing_simps slicing_commute]:
cat_Comp_vdomain = smc.smc_Comp_vdomain
and cat_Comp_is_arr[cat_cs_intros] = smc.smc_Comp_is_arr
and cat_Comp_assoc[cat_cs_intros] = smc.smc_Comp_assoc
and cat_Comp_vdomainI[cat_cs_intros] = smc.smc_Comp_vdomainI
and cat_Comp_vdomainE[elim!] = smc.smc_Comp_vdomainE
and cat_Comp_vdomain_is_composable_arrs =
smc.smc_Comp_vdomain_is_composable_arrs
and cat_Comp_vrange = smc.smc_Comp_vrange
and cat_Comp_vsubset_Vset = smc.smc_Comp_vsubset_Vset
and cat_Comp_in_Vset = smc.smc_Comp_in_Vset
and cat_Comp_vempty_if_Arr_vempty = smc.smc_Comp_vempty_if_Arr_vempty
and cat_assoc_helper = smc.smc_assoc_helper
and cat_pattern_rectangle_right = smc.smc_pattern_rectangle_right
and cat_pattern_rectangle_left = smc.smc_pattern_rectangle_left
and is_epic_arrI = smc.is_epic_arrI
and is_epic_arrD[dest] = smc.is_epic_arrD
and is_epic_arrE[elim!] = smc.is_epic_arrE
and cat_comp_is_monic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_monic_arr
and cat_comp_is_epic_arr[cat_arrow_cs_intros] = smc.smc_Comp_is_epic_arr
and cat_comp_is_monic_arr_is_monic_arr =
smc.smc_Comp_is_monic_arr_is_monic_arr
and cat_is_zero_arr_comp_right[cat_arrow_cs_intros] =
smc.smc_is_zero_arr_Comp_right
and cat_is_zero_arr_comp_left[cat_arrow_cs_intros] =
smc.smc_is_zero_arr_Comp_left
lemma cat_Comp_is_arr'[cat_cs_intros]:
assumes "g : b β¦βββ c"
and "f : a β¦βββ b"
and "β' = β"
shows "g ββ©Aβββ f : a β¦ββ'β c"
using assms(1,2) unfolding assms(3) by (rule cat_Comp_is_arr)
end
lemmas [cat_cs_simps] = is_idem_arrD(2)
lemmas [cat_cs_simps] = category.cat_Comp_assoc
lemmas [cat_cs_intros] =
category.cat_Comp_vdomainI
category.cat_is_arrD(1-3)
category.cat_Comp_is_arr'
category.cat_Comp_is_arr
lemmas [cat_arrow_cs_intros] =
is_monic_arrD(1)
is_epic_arr_is_arr
category.cat_comp_is_monic_arr
category.cat_comp_is_epic_arr
category.cat_is_zero_arr_comp_right
category.cat_is_zero_arr_comp_left
lemmas [cat_cs_intros] = HomI
lemmas [cat_cs_simps] = in_Hom_iff
textβΉElementary properties.βΊ
lemma cat_eqI:
assumes "category Ξ± π"
and "category Ξ± π
"
and "πβ¦Objβ¦ = π
β¦Objβ¦"
and "πβ¦Arrβ¦ = π
β¦Arrβ¦"
and "πβ¦Domβ¦ = π
β¦Domβ¦"
and "πβ¦Codβ¦ = π
β¦Codβ¦"
and "πβ¦Compβ¦ = π
β¦Compβ¦"
and "πβ¦CIdβ¦ = π
β¦CIdβ¦"
shows "π = π
"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
show ?thesis
proof(rule vsv_eqI)
have dom: "πβ©β π = 6β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
show "πβ©β π = πβ©β π
" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
show "a ββ©β πβ©β π βΉ πβ¦aβ¦ = π
β¦aβ¦" for a
by (unfold dom, elim_in_numeral, insert assms) (auto simp: dg_field_simps)
qed auto
qed
lemma cat_smc_eqI:
assumes "category Ξ± π"
and "category Ξ± π
"
and "πβ¦CIdβ¦ = π
β¦CIdβ¦"
and "cat_smc π = cat_smc π
"
shows "π = π
"
proof(rule cat_eqI[of Ξ±])
from assms(4) have
"cat_smc πβ¦Objβ¦ = cat_smc π
β¦Objβ¦"
"cat_smc πβ¦Arrβ¦ = cat_smc π
β¦Arrβ¦"
"cat_smc πβ¦Domβ¦ = cat_smc π
β¦Domβ¦"
"cat_smc πβ¦Codβ¦ = cat_smc π
β¦Codβ¦"
"cat_smc πβ¦Compβ¦ = cat_smc π
β¦Compβ¦"
by auto
then show
"πβ¦Objβ¦ = π
β¦Objβ¦"
"πβ¦Arrβ¦ = π
β¦Arrβ¦"
"πβ¦Domβ¦ = π
β¦Domβ¦"
"πβ¦Codβ¦ = π
β¦Codβ¦"
"πβ¦Compβ¦ = π
β¦Compβ¦"
unfolding slicing_simps by simp_all
qed (auto simp: assms)
lemma (in category) cat_def:
"β = [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Domβ¦, ββ¦Codβ¦, ββ¦Compβ¦, ββ¦CIdβ¦]β©β"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β β = 6β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
have dom_rhs: "πβ©β [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Domβ¦, ββ¦Codβ¦, ββ¦Compβ¦, ββ¦CIdβ¦]β©β = 6β©β"
by (simp add: nat_omega_simps)
then show "πβ©β β = πβ©β [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Domβ¦, ββ¦Codβ¦, ββ¦Compβ¦, ββ¦CIdβ¦]β©β"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β β βΉ
ββ¦aβ¦ = [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Domβ¦, ββ¦Codβ¦, ββ¦Compβ¦, ββ¦CIdβ¦]β©ββ¦aβ¦"
for a
unfolding dom_lhs
by elim_in_numeral (simp_all add: dg_field_simps nat_omega_simps)
qed auto
textβΉSize.βΊ
lemma (in category) cat_CId_vsubset_Vset: "ββ¦CIdβ¦ ββ©β Vset Ξ±"
proof(intro vsubsetI)
fix af assume "af ββ©β ββ¦CIdβ¦"
then obtain a f
where af_def: "af = β¨a, fβ©"
and a: "a ββ©β πβ©β (ββ¦CIdβ¦)"
and f: "f ββ©β ββ©β (ββ¦CIdβ¦)"
by (auto elim: CId.vbrelation_vinE)
from a have "a ββ©β Vset Ξ±" by (auto simp: cat_cs_simps intro: cat_cs_intros)
from f cat_CId_vrange have "f ββ©β ββ¦Arrβ¦" by auto
then have "f ββ©β Vset Ξ±" by (auto simp: cat_cs_simps intro: cat_cs_intros)
then show "af ββ©β Vset Ξ±"
by (simp add: af_def Limit_vpair_in_VsetI βΉa ββ©β Vset Ξ±βΊ)
qed
lemma (in category) cat_category_in_Vset_4: "β ββ©β Vset (Ξ± + 4β©β)"
proof-
note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
cat_Obj_vsubset_Vset
cat_Arr_vsubset_Vset
cat_Dom_vsubset_Vset
cat_Cod_vsubset_Vset
cat_Comp_vsubset_Vset
cat_CId_vsubset_Vset
show ?thesis
by (subst cat_def, succ_of_numeral)
(
cs_concl
cs_simp: plus_V_succ_right V_cs_simps
cs_intro: cat_cs_intros V_cs_intros
)
qed
lemma (in category) cat_CId_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ββ¦CIdβ¦ ββ©β Vset Ξ²"
proof-
interpret π΅ Ξ² by (rule assms(1))
from assms have "πβ©β (ββ¦CIdβ¦) ββ©β Vset Ξ²"
by (auto simp: cat_cs_simps cat_Obj_in_Vset)
moreover from assms cat_CId_vrange have "ββ©β (ββ¦CIdβ¦) ββ©β Vset Ξ²"
by (auto intro: cat_Arr_in_Vset)
ultimately show ?thesis by (blast intro: π΅_Limit_Ξ±Ο)
qed
lemma (in category) cat_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "β ββ©β Vset Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show ?thesis
proof(rule vsv.vsv_Limit_vsv_in_VsetI)
have dom: "πβ©β β = 6β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
from assms show "πβ©β β ββ©β Vset Ξ²"
unfolding dom by (simp add: π΅.ord_of_nat_in_Vset)
have "n ββ©β πβ©β β βΉ ββ¦nβ¦ ββ©β Vset Ξ²" for n
unfolding dom
by
(
elim_in_numeral,
allβΉrewrite in "β ββ©β _" dg_field_simps[symmetric]βΊ,
insert assms
)
(
auto simp:
cat_Obj_in_Vset
cat_Arr_in_Vset
cat_Dom_in_Vset
cat_Cod_in_Vset
cat_Comp_in_Vset
cat_CId_in_Vset
)
then show "ββ©β β ββ©β Vset Ξ²" by (metis vsubsetI vrange_atD)
show "vfinite (πβ©β β)" unfolding dom by auto
qed (simp_all add: π΅_Limit_Ξ±Ο vsv_axioms)
qed
lemma (in category) cat_category_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "category Ξ² β"
by (rule categoryI)
(
auto
intro: cat_cs_intros
simp: cat_cs_simps assms vfsequence_axioms cat_semicategory_if_ge_Limit
)
lemma tiny_category[simp]: "small {β. category Ξ± β}"
proof(cases βΉπ΅ Ξ±βΊ)
case True
from category.cat_in_Vset[of Ξ±] show ?thesis
by (intro down[of _ βΉVset (Ξ± + Ο)βΊ])
(auto simp: True π΅.π΅_Limit_Ξ±Ο π΅.π΅_Ο_Ξ±Ο π΅.intro π΅.π΅_Ξ±_Ξ±Ο)
next
case False
then have "{β. category Ξ± β} = {}" by auto
then show ?thesis by simp
qed
lemma (in π΅) categories_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "set {β. category Ξ± β} ββ©β Vset Ξ²"
proof(rule vsubset_in_VsetI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "set {β. category Ξ± β} ββ©β Vset (Ξ± + 4β©β)"
proof(intro vsubsetI)
fix β assume prems: "β ββ©β set {β. category Ξ± β}"
interpret category Ξ± β using prems by simp
show "β ββ©β Vset (Ξ± + 4β©β)"
unfolding VPow_iff by (rule cat_category_in_Vset_4)
qed
from assms(2) show "Vset (Ξ± + 4β©β) ββ©β Vset Ξ²"
by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed
lemma category_if_category:
assumes "category Ξ² β"
and "π΅ Ξ±"
and "ββ¦Objβ¦ ββ©β Vset Ξ±"
and "βA B. β¦ A ββ©β ββ¦Objβ¦; B ββ©β ββ¦Objβ¦; A ββ©β Vset Ξ±; B ββ©β Vset Ξ± β§ βΉ
(ββ©βaββ©βA. ββ©βbββ©βB. Hom β a b) ββ©β Vset Ξ±"
shows "category Ξ± β"
proof-
interpret category Ξ² β by (rule assms(1))
interpret Ξ±: π΅ Ξ± by (rule assms(2))
show ?thesis
proof(intro categoryI)
show "vfsequence β" by (simp add: vfsequence_axioms)
show "semicategory Ξ± (cat_smc β)"
by (rule semicategory_if_semicategory, unfold slicing_simps)
(auto intro!: assms(1,3,4) slicing_intros)
qed (auto intro: cat_cs_intros simp: cat_cs_simps)
qed
textβΉFurther elementary properties.βΊ
sublocale category β CId: v11 βΉββ¦CIdβ¦βΊ
proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
fix a b assume prems:
"a ββ©β ββ¦Objβ¦" "b ββ©β ββ¦Objβ¦" "ββ¦CIdβ¦β¦aβ¦ = ββ¦CIdβ¦β¦bβ¦"
have "ββ¦CIdβ¦β¦aβ¦ : b β¦βββ b" "ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
by (subst prems(3))
(cs_concl cs_simp: cat_cs_simps cs_intro: prems(1,2) cat_cs_intros)+
with prems show "a = b" by auto
qed auto
lemma (in category) cat_CId_vempty_if_Arr_vempty:
assumes "ββ¦Arrβ¦ = 0"
shows "ββ¦CIdβ¦ = 0"
using assms cat_CId_vrange by (auto intro: CId.vsv_vrange_vempty)
subsectionβΉOpposite categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-2 in \cite{mac_lane_categories_2010}.βΊ
definition op_cat :: "V β V"
where "op_cat β = [ββ¦Objβ¦, ββ¦Arrβ¦, ββ¦Codβ¦, ββ¦Domβ¦, fflip (ββ¦Compβ¦), ββ¦CIdβ¦]β©β"
textβΉComponents.βΊ
lemma op_cat_components:
shows [cat_op_simps]: "op_cat ββ¦Objβ¦ = ββ¦Objβ¦"
and [cat_op_simps]: "op_cat ββ¦Arrβ¦ = ββ¦Arrβ¦"
and [cat_op_simps]: "op_cat ββ¦Domβ¦ = ββ¦Codβ¦"
and [cat_op_simps]: "op_cat ββ¦Codβ¦ = ββ¦Domβ¦"
and "op_cat ββ¦Compβ¦ = fflip (ββ¦Compβ¦)"
and [cat_op_simps]: "op_cat ββ¦CIdβ¦ = ββ¦CIdβ¦"
unfolding op_cat_def dg_field_simps by (auto simp: nat_omega_simps)
lemma op_cat_component_intros[cat_op_intros]:
shows "a ββ©β ββ¦Objβ¦ βΉ a ββ©β op_cat ββ¦Objβ¦"
and "f ββ©β ββ¦Arrβ¦ βΉ f ββ©β op_cat ββ¦Arrβ¦"
unfolding cat_op_simps by simp_all
textβΉSlicing.βΊ
lemma cat_smc_op_cat[slicing_commute]: "op_smc (cat_smc β) = cat_smc (op_cat β)"
unfolding cat_smc_def op_cat_def op_smc_def dg_field_simps
by (simp add: nat_omega_simps)
lemma (in category) op_smc_op_cat[cat_op_simps]: "op_smc (op_cat β) = cat_smc β"
using Comp.pbinop_fflip_fflip
unfolding op_smc_def op_cat_def cat_smc_def dg_field_simps
by (simp add: nat_omega_simps)
lemma op_cat_is_arr[cat_op_simps]: "f : b β¦βop_cat ββ a β· f : a β¦βββ b"
unfolding cat_op_simps is_arr_def by auto
lemmas [cat_op_intros] = op_cat_is_arr[THEN iffD2]
lemma op_cat_Hom[cat_op_simps]: "Hom (op_cat β) a b = Hom β b a"
unfolding cat_op_simps by simp
lemma op_cat_obj_initial[cat_op_simps]:
"obj_initial (op_cat β) a β· obj_terminal β a"
unfolding obj_initial_def obj_terminal_def
unfolding smc_op_simps cat_op_simps
..
lemmas [cat_op_intros] = op_cat_obj_initial[THEN iffD2]
lemma op_cat_obj_terminal[cat_op_simps]:
"obj_terminal (op_cat β) a β· obj_initial β a"
unfolding obj_initial_def obj_terminal_def
unfolding smc_op_simps cat_op_simps
..
lemmas [cat_op_intros] = op_cat_obj_terminal[THEN iffD2]
lemma op_cat_obj_null[cat_op_simps]: "obj_null (op_cat β) a β· obj_null β a"
unfolding obj_null_def cat_op_simps by auto
lemmas [cat_op_intros] = op_cat_obj_null[THEN iffD2]
context category
begin
interpretation smc: semicategory Ξ± βΉcat_smc ββΊ by (rule cat_semicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
op_cat_Comp_vrange[cat_op_simps] = smc.op_smc_Comp_vrange
and op_cat_Comp[cat_op_simps] = smc.op_smc_Comp
and op_cat_is_epic_arr[cat_op_simps] = smc.op_smc_is_epic_arr
and op_cat_is_monic_arr[cat_op_simps] = smc.op_smc_is_monic_arr
and op_cat_is_zero_arr[cat_op_simps] = smc.op_smc_is_zero_arr
end
lemmas [cat_op_simps] =
category.op_cat_Comp_vrange
category.op_cat_Comp
category.op_cat_is_epic_arr
category.op_cat_is_monic_arr
category.op_cat_is_zero_arr
context
fixes β :: V
begin
lemmas_with [
where β=βΉcat_smc ββΊ, unfolded slicing_simps slicing_commute[symmetric]
]:
op_cat_Comp_vdomain[cat_op_simps] = op_smc_Comp_vdomain
end
textβΉElementary properties.βΊ
lemma op_cat_vsv[cat_op_intros]: "vsv (op_cat β)" unfolding op_cat_def by auto
subsubsectionβΉFurther propertiesβΊ
lemma (in category) category_op[cat_cs_intros]: "category Ξ± (op_cat β)"
proof(intro categoryI, unfold cat_op_simps)
show "vfsequence (op_cat β)" unfolding op_cat_def by simp
show "vcard (op_cat β) = 6β©β"
unfolding op_cat_def by (simp add: nat_omega_simps)
next
fix f a b assume "f : b β¦βββ a"
with category_axioms show "ββ¦CIdβ¦β¦bβ¦ ββ©Aβop_cat ββ f = f"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
next
fix f b c assume "f : c β¦βββ b"
with category_axioms show "f ββ©Aβop_cat ββ ββ¦CIdβ¦β¦bβ¦ = f"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed
(
auto simp:
cat_cs_simps
cat_op_simps
slicing_commute[symmetric]
smc_op_intros
cat_cs_intros
cat_semicategory
)
lemmas category_op[cat_op_intros] = category.category_op
lemma (in category) cat_op_cat_op_cat[cat_op_simps]: "op_cat (op_cat β) = β"
proof(rule cat_eqI, unfold cat_op_simps op_cat_components)
show "category Ξ± (op_cat (op_cat β))"
by (simp add: category.category_op category_op)
show "fflip (fflip (ββ¦Compβ¦)) = ββ¦Compβ¦" by (rule Comp.pbinop_fflip_fflip)
qed (auto simp: cat_cs_intros)
lemmas cat_op_cat_op_cat[cat_op_simps] = category.cat_op_cat_op_cat
lemma eq_op_cat_iff[cat_op_simps]:
assumes "category Ξ± π" and "category Ξ± π
"
shows "op_cat π = op_cat π
β· π = π
"
proof
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
assume prems: "op_cat π = op_cat π
"
show "π = π
"
proof(rule cat_eqI)
show
"πβ¦Objβ¦ = π
β¦Objβ¦"
"πβ¦Arrβ¦ = π
β¦Arrβ¦"
"πβ¦Domβ¦ = π
β¦Domβ¦"
"πβ¦Codβ¦ = π
β¦Codβ¦"
"πβ¦Compβ¦ = π
β¦Compβ¦"
"πβ¦CIdβ¦ = π
β¦CIdβ¦"
by (metis π.cat_op_cat_op_cat π
.cat_op_cat_op_cat prems)+
qed (auto intro: cat_cs_intros)
qed auto
subsectionβΉMonic arrow and epic arrowβΊ
lemma (in category) cat_CId_is_monic_arr[cat_arrow_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦"
shows "ββ¦CIdβ¦β¦aβ¦ : a β¦β©mβ©oβ©nβββ a"
using assms cat_CId_is_arr' cat_CId_left_left by (force intro!: is_monic_arrI)
lemmas [cat_arrow_cs_intros] = category.cat_CId_is_monic_arr
lemma (in category) cat_CId_is_epic_arr[cat_arrow_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦"
shows "ββ¦CIdβ¦β¦aβ¦ : a β¦β©eβ©pβ©iβββ a"
proof-
from assms have "a ββ©β op_cat ββ¦Objβ¦" unfolding cat_op_simps .
from category.cat_CId_is_monic_arr[OF category_op this, unfolded cat_op_simps]
show ?thesis.
qed
lemmas [cat_arrow_cs_intros] = category.cat_CId_is_epic_arr
subsectionβΉRight inverse and left inverse of an arrowβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
definition is_right_inverse :: "V β V β V β bool"
where "is_right_inverse β g f =
(βa b. g : b β¦βββ a β§ f : a β¦βββ b β§ f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦)"
definition is_left_inverse :: "V β V β V β bool"
where "is_left_inverse β β‘ is_right_inverse (op_cat β)"
textβΉRules.βΊ
lemma is_right_inverseI:
assumes "g : b β¦βββ a" and "f : a β¦βββ b" and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
shows "is_right_inverse β g f"
using assms unfolding is_right_inverse_def by auto
lemma is_right_inverseD[dest]:
assumes "is_right_inverse β g f"
shows "βa b. g : b β¦βββ a β§ f : a β¦βββ b β§ f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
using assms unfolding is_right_inverse_def by clarsimp
lemma is_right_inverseE[elim]:
assumes "is_right_inverse β g f"
obtains a b where "g : b β¦βββ a"
and "f : a β¦βββ b"
and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
using assms by auto
lemma (in category) is_left_inverseI:
assumes "g : b β¦βββ a" and "f : a β¦βββ b" and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
shows "is_left_inverse β g f"
proof-
from assms(3) have "f ββ©Aβop_cat ββ g = ββ¦CIdβ¦β¦aβ¦"
unfolding op_cat_Comp[OF assms(1,2)].
from
is_right_inverseI[of βΉop_cat ββΊ, unfolded cat_op_simps, OF assms(1,2) this]
show ?thesis
unfolding is_left_inverse_def .
qed
lemma (in category) is_left_inverseD[dest]:
assumes "is_left_inverse β g f"
shows "βa b. g : b β¦βββ a β§ f : a β¦βββ b β§ g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
proof-
from is_right_inverseD[OF assms[unfolded is_left_inverse_def]] obtain a b
where "g : b β¦βop_cat ββ a"
and "f : a β¦βop_cat ββ b"
and fg: "f ββ©Aβop_cat ββ g = op_cat ββ¦CIdβ¦β¦bβ¦"
by clarsimp
then have g: "g : a β¦βββ b" and f: "f : b β¦βββ a"
unfolding cat_op_simps by simp_all
moreover from fg have "g ββ©Aβββ f = ββ¦CIdβ¦β¦bβ¦"
unfolding op_cat_Comp[OF g f] cat_op_simps by simp
ultimately show ?thesis by blast
qed
lemma (in category) is_left_inverseE[elim]:
assumes "is_left_inverse β g f"
obtains a b where "g : b β¦βββ a"
and "f : a β¦βββ b"
and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
using assms by auto
textβΉElementary properties.βΊ
lemma (in category) op_cat_is_left_inverse[cat_op_simps]:
"is_left_inverse (op_cat β) g f β· is_right_inverse β g f"
unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp
lemmas [cat_op_simps] = category.op_cat_is_left_inverse
lemmas [cat_op_intros] = category.op_cat_is_left_inverse[THEN iffD2]
lemma (in category) op_cat_is_right_inverse[cat_op_simps]:
"is_right_inverse (op_cat β) g f β· is_left_inverse β g f"
unfolding is_left_inverse_def is_right_inverse_def cat_op_simps by simp
lemmas [cat_op_simps] = category.op_cat_is_right_inverse
lemmas [cat_op_intros] = category.op_cat_is_right_inverse[THEN iffD2]
subsectionβΉInverse of an arrowβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
definition is_inverse :: "V β V β V β bool"
where "is_inverse β g f =
(
βa b.
g : b β¦βββ a β§
f : a β¦βββ b β§
g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦ β§
f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦
)"
textβΉRules.βΊ
lemma is_inverseI:
assumes "g : b β¦βββ a"
and "f : a β¦βββ b"
and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
shows "is_inverse β g f"
using assms unfolding is_inverse_def by auto
lemma is_inverseD[dest]:
assumes "is_inverse β g f"
shows
"(
βa b.
g : b β¦βββ a β§
f : a β¦βββ b β§
g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦ β§
f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦
)"
using assms unfolding is_inverse_def by auto
lemma is_inverseE[elim]:
assumes "is_inverse β g f"
obtains a b where "g : b β¦βββ a"
and "f : a β¦βββ b"
and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
using assms by auto
textβΉElementary properties.βΊ
lemma (in category) op_cat_is_inverse[cat_op_simps]:
"is_inverse (op_cat β) g f β· is_inverse β g f"
by (rule iffI; unfold is_inverse_def cat_op_simps) (metis op_cat_Comp)+
lemmas [cat_op_simps] = category.op_cat_is_inverse
lemmas [cat_op_intros] = category.op_cat_is_inverse[THEN iffD2]
lemma is_inverse_sym: "is_inverse β g f β· is_inverse β f g"
unfolding is_inverse_def by auto
lemma (in category) cat_is_inverse_eq:
assumes "is_inverse β h f" and "is_inverse β g f"
shows "h = g"
using assms
proof(elim is_inverseE)
fix a b a' b'
assume prems:
"h : b β¦βββ a"
"f : a β¦βββ b"
"h ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
"f ββ©Aβββ h = ββ¦CIdβ¦β¦bβ¦"
"g : b' β¦βββ a'"
"f : a' β¦βββ b'"
"g ββ©Aβββ f = ββ¦CIdβ¦β¦a'β¦"
then have ab: "a' = a" "b' = b" by auto
from prems have gf: "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦" and g: "g : b β¦βββ a"
unfolding ab by simp_all
from prems(1) have "h = (g ββ©Aβββ f) ββ©Aβββ h"
unfolding gf by (simp add: cat_cs_simps)
also with category_axioms prems(1,2) g have "β¦ = g"
by (cs_concl cs_simp: prems(4) cat_cs_simps cs_intro: cat_cs_intros)
finally show "h = g" by simp
qed
lemma is_inverse_Comp_CId_left:
assumes "is_inverse β g' g" and "g : a β¦βββ b"
shows "g' ββ©Aβββ g = ββ¦CIdβ¦β¦aβ¦"
using assms by auto
lemma is_inverse_Comp_CId_right:
assumes "is_inverse β g' g" and "g : a β¦βββ b"
shows "g ββ©Aβββ g' = ββ¦CIdβ¦β¦bβ¦"
by (metis assms is_arrD(3) is_inverseE)
lemma (in category) cat_is_inverse_Comp:
assumes gbc[intro]: "g : b β¦βββ c"
and fab[intro]: "f : a β¦βββ b"
and g'g[intro]: "is_inverse β g' g"
and f'f[intro]: "is_inverse β f' f"
shows "is_inverse β (f' ββ©Aβββ g') (g ββ©Aβββ f)"
proof-
from g'g gbc f'f fab have g'cb: "g' : c β¦βββ b" and f'ba: "f' : b β¦βββ a"
by (metis is_arrD(2,3) is_inverseD)+
with assms have f'g': "f' ββ©Aβββ g' : c β¦βββ a" and gf: "g ββ©Aβββ f : a β¦βββ c"
by (auto intro: cat_Comp_is_arr)
have ff': "is_inverse β f f'" using assms by (simp add: is_inverse_sym)
note [simp] =
cat_Comp_assoc[symmetric, OF f'g' gbc fab]
cat_Comp_assoc[OF f'ba g'cb gbc]
is_inverse_Comp_CId_left[OF g'g gbc]
cat_Comp_assoc[symmetric, OF gf f'ba g'cb]
cat_Comp_assoc[OF gbc fab f'ba]
is_inverse_Comp_CId_left[OF ff' f'ba]
cat_CId_right_left[OF f'ba]
cat_CId_right_left[OF gbc]
show ?thesis
by (intro is_inverseI, rule f'g', rule gf)
(auto intro: is_inverse_Comp_CId_left is_inverse_Comp_CId_right)
qed
lemma (in category) cat_is_inverse_Comp':
assumes "g : b β¦βββ c"
and "f : a β¦βββ b"
and "is_inverse β g' g"
and "is_inverse β f' f"
and "f'g' = f' ββ©Aβββ g'"
and "gf = g ββ©Aβββ f"
shows "is_inverse β f'g' gf"
using assms(1-4) unfolding assms(5,6) by (intro cat_is_inverse_Comp)
lemmas [cat_cs_intros] = category.cat_is_inverse_Comp'
lemma is_inverse_is_right_inverse[dest]:
assumes "is_inverse β g f"
shows "is_right_inverse β g f"
using assms by (auto intro: is_right_inverseI)
lemma (in category) cat_is_inverse_is_left_inverse[dest]:
assumes "is_inverse β g f"
shows "is_left_inverse β g f"
proof-
interpret op: category Ξ± βΉop_cat ββΊ by (auto intro!: cat_cs_intros)
from assms have "is_inverse (op_cat β) g f" by (simp add: cat_op_simps)
from is_inverse_is_right_inverse[OF this] show ?thesis
unfolding is_left_inverse_def .
qed
lemma (in category) cat_is_right_left_inverse_is_inverse:
assumes "is_right_inverse β g f" "is_left_inverse β g f"
shows "is_inverse β g f"
using assms
proof(elim is_right_inverseE is_left_inverseE)
fix a b c d assume prems:
"g : b β¦βββ a"
"f : a β¦βββ b"
"f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
"g : d β¦βββ c"
"f : c β¦βββ d"
"g ββ©Aβββ f = ββ¦CIdβ¦β¦cβ¦"
then have dbca: "d = b" "c = a" by auto
note [cat_cs_simps] = prems(3,6)[unfolded dbca]
from prems(1,2) show "is_inverse β g f"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_inverseI)
qed
subsectionβΉIsomorphismβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
definition is_arr_isomorphism :: "V β V β V β V β bool"
where "is_arr_isomorphism β a b f β·
(f : a β¦βββ b β§ (βg. is_inverse β g f))"
syntax "_is_arr_isomorphism" :: "V β V β V β V β bool"
(βΉ_ : _ β¦β©iβ©sβ©oΔ± _βΊ [51, 51, 51] 51)
translations "f : a β¦β©iβ©sβ©oβββ b" β "CONST is_arr_isomorphism β a b f"
textβΉRules.βΊ
lemma is_arr_isomorphismI:
assumes "f : a β¦βββ b" and "is_inverse β g f"
shows "f : a β¦β©iβ©sβ©oβββ b"
using assms unfolding is_arr_isomorphism_def by auto
lemma is_arr_isomorphismD[dest]:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "f : a β¦βββ b" and "βg. is_inverse β g f"
using assms unfolding is_arr_isomorphism_def by auto
lemma is_arr_isomorphismE[elim]:
assumes "f : a β¦β©iβ©sβ©oβββ b"
obtains g where "f : a β¦βββ b" and "is_inverse β g f"
using assms by force
lemma is_arr_isomorphismE':
assumes "f : a β¦β©iβ©sβ©oβββ b"
obtains g where "g : b β¦β©iβ©sβ©oβββ a"
and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
proof-
from assms obtain g where f: "f : a β¦βββ b" "is_inverse β g f" by auto
then have "g : b β¦βββ a"
and "f : a β¦βββ b"
and gf: "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and fg: "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
by auto
then have g: "g : b β¦β©iβ©sβ©oβββ a"
by (cs_concl cs_intro: is_inverseI is_arr_isomorphismI)
from that f g gf fg show ?thesis by simp
qed
textβΉElementary properties.βΊ
lemma (in category) op_cat_is_arr_isomorphism[cat_op_simps]:
"f : b β¦β©iβ©sβ©oβop_cat ββ a β· f : a β¦β©iβ©sβ©oβββ b"
unfolding is_arr_isomorphism_def cat_op_simps by simp
lemmas [cat_op_simps] = category.op_cat_is_arr_isomorphism
lemmas [cat_op_intros] = category.op_cat_is_arr_isomorphism[THEN iffD2]
lemma (in category) is_arr_isomorphismI':
assumes "f : a β¦βββ b"
and "g : b β¦βββ a"
and "g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and "f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
shows "f : a β¦β©iβ©sβ©oβββ b" and "g : b β¦β©iβ©sβ©oβββ a"
proof-
from assms have gf: "is_inverse β g f" by (auto intro: is_inverseI)
from assms have fg: "is_inverse β f g" by (auto intro: is_inverseI)
show "f : a β¦β©iβ©sβ©oβββ b" and "g : b β¦β©iβ©sβ©oβββ a"
by
(
intro
is_arr_isomorphismI[OF assms(1) gf]
is_arr_isomorphismI[OF assms(2) fg]
)+
qed
lemma (in category) cat_is_inverse_is_arr_isomorphism:
assumes "f : a β¦βββ b" and "is_inverse β g f"
shows "g : b β¦β©iβ©sβ©oβββ a"
proof(intro is_arr_isomorphismI is_inverseI)
from assms(2) obtain a' b'
where g: "g : b' β¦βββ a'"
and f: "f : a' β¦βββ b'"
and gf: "g ββ©Aβββ f = ββ¦CIdβ¦β¦a'β¦"
and fg: "f ββ©Aβββ g = ββ¦CIdβ¦β¦b'β¦"
by auto
with assms(1) have a'b': "a' = a" "b' = b" by auto
from g f gf fg show
"g : b β¦βββ a"
"f : a β¦βββ b"
"g : b β¦βββ a"
"f ββ©Aβββ g = ββ¦CIdβ¦β¦bβ¦"
"g ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
unfolding a'b' by auto
qed
lemma (in category) cat_Comp_is_arr_isomorphism[cat_arrow_cs_intros]:
assumes "g : b β¦β©iβ©sβ©oβββ c" and "f : a β¦β©iβ©sβ©oβββ b"
shows "g ββ©Aβββ f : a β¦β©iβ©sβ©oβββ c"
proof-
from assms have [intro]: "g ββ©Aβββ f : a β¦βββ c"
by (auto intro: cat_cs_intros)
from assms(1) obtain g' where g'g: "is_inverse β g' g" by force
with assms(1) have [intro]: "g' : c β¦βββ b"
by (elim is_arr_isomorphismE)
(auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
from assms(2) obtain f' where f'f: "is_inverse β f' f" by auto
with assms(2) have [intro]: "f' : b β¦βββ a"
by (elim is_arr_isomorphismE)
(auto simp: is_arr_isomorphismD cat_is_inverse_is_arr_isomorphism)
have "f' ββ©Aβββ g' : c β¦βββ a" by (auto intro: cat_cs_intros)
from cat_is_inverse_Comp[OF _ _ g'g f'f] assms
have "is_inverse β (f' ββ©Aβββ g') (g ββ©Aβββ f)"
by (elim is_arr_isomorphismE) simp
then show ?thesis by (auto intro: is_arr_isomorphismI)
qed
lemmas [cat_arrow_cs_intros] = category.cat_Comp_is_arr_isomorphism
lemma (in category) cat_CId_is_arr_isomorphism:
assumes "a ββ©β ββ¦Objβ¦"
shows "ββ¦CIdβ¦β¦aβ¦ : a β¦β©iβ©sβ©oβββ a"
using assms
by
(
cs_concl
cs_intro: cat_cs_intros is_inverseI cat_is_inverse_is_arr_isomorphism
cs_simp: cat_cs_simps
)
lemma (in category) cat_CId_is_arr_isomorphism'[cat_arrow_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦"
and "β' = β"
and "b = a"
and "c = a"
shows "ββ¦CIdβ¦β¦aβ¦ : b β¦β©iβ©sβ©oββ'β c"
using assms(1)
unfolding assms(2-4)
by (rule cat_CId_is_arr_isomorphism)
lemmas [cat_arrow_cs_intros] = category.cat_CId_is_arr_isomorphism'
lemma (in category) cat_is_arr_isomorphism_is_monic_arr[cat_arrow_cs_intros]:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "f : a β¦β©mβ©oβ©nβββ b"
proof(intro is_monic_arrI)
note [cat_cs_intros] = is_arr_isomorphismD(1)
show "f : a β¦βββ b" by (intro is_arr_isomorphismD(1)[OF assms])
fix h g c assume prems:
"h : c β¦βββ a" "g : c β¦βββ a" "f ββ©Aβββ h = f ββ©Aβββ g"
from assms obtain f'
where f': "f' : b β¦β©iβ©sβ©oβββ a"
and [cat_cs_simps]: "f' ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
by (auto elim: is_arr_isomorphismE')
from category_axioms assms prems(1,2) have "h = (f' ββ©Aβββ f) ββ©Aβββ h"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms assms prems(1,2) f' have "β¦ = (f' ββ©Aβββ f) ββ©Aβββ g"
by (cs_concl cs_simp: prems(3) cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms assms prems(1,2) f' have "β¦ = g"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally show "h = g" by simp
qed
lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_monic_arr
lemma (in category) cat_is_arr_isomorphism_is_epic_arr:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "f : a β¦β©eβ©pβ©iβββ b"
using assms
by
(
rule
category.cat_is_arr_isomorphism_is_monic_arr[
OF category_op, unfolded cat_op_simps
]
)
lemmas [cat_arrow_cs_intros] = category.cat_is_arr_isomorphism_is_epic_arr
subsectionβΉThe inverse arrowβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
definition the_inverse :: "V β V β V" (βΉ(_Β―β©CΔ±)βΊ [1000] 999)
where "fΒ―β©Cβββ = (THE g. is_inverse β g f)"
textβΉElementary properties.βΊ
lemma (in category) cat_is_inverse_is_inverse_the_inverse:
assumes "is_inverse β g f"
shows "is_inverse β (fΒ―β©Cβββ) f"
unfolding the_inverse_def
proof(rule theI)
fix g' assume "is_inverse β g' f"
then show "g' = g" by (meson cat_is_inverse_eq assms)
qed (rule assms)
lemma (in category) cat_is_inverse_eq_the_inverse:
assumes "is_inverse β g f"
shows "g = fΒ―β©Cβββ"
by (meson assms cat_is_inverse_is_inverse_the_inverse cat_is_inverse_eq)
textβΉThe inverse arrow is an inverse of an isomorphism.βΊ
lemma (in category) cat_the_inverse_is_inverse:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "is_inverse β (fΒ―β©Cβββ) f"
proof-
from assms obtain g where "is_inverse β g f" by auto
then show "is_inverse β (fΒ―β©Cβββ) f"
by (rule cat_is_inverse_is_inverse_the_inverse)
qed
lemma (in category) cat_the_inverse_is_arr_isomorphism:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "fΒ―β©Cβββ : b β¦β©iβ©sβ©oβββ a"
proof-
from assms have f: "f : a β¦βββ b" by auto
have "is_inverse β (fΒ―β©Cβββ) f" by (rule cat_the_inverse_is_inverse[OF assms])
from cat_is_inverse_is_arr_isomorphism[OF f this] show ?thesis .
qed
lemma (in category) cat_the_inverse_is_arr_isomorphism':
assumes "f : a β¦β©iβ©sβ©oβββ b" and "β' = β"
shows "fΒ―β©Cβββ : b β¦β©iβ©sβ©oββ'β a"
using assms(1)
unfolding assms(2)
by (rule cat_the_inverse_is_arr_isomorphism)
lemmas [cat_cs_intros] = category.cat_the_inverse_is_arr_isomorphism'
lemma (in category) op_cat_the_inverse:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "fΒ―β©Cβop_cat ββ = fΒ―β©Cβββ"
proof-
from assms have "f : b β¦β©iβ©sβ©oβop_cat ββ a" unfolding cat_op_simps by simp
from assms show ?thesis
by
(
intro
category.cat_is_inverse_eq_the_inverse[
symmetric, OF category_op, unfolded cat_op_simps
]
cat_the_inverse_is_inverse
)
qed
lemmas [cat_op_simps] = category.op_cat_the_inverse
lemma (in category) cat_Comp_the_inverse:
assumes "g : b β¦β©iβ©sβ©oβββ c" and "f : a β¦β©iβ©sβ©oβββ b"
shows "(g ββ©Aβββ f)Β―β©Cβββ = fΒ―β©Cβββ ββ©Aβββ gΒ―β©Cβββ"
proof-
from assms have "g ββ©Aβββ f : a β¦β©iβ©sβ©oβββ c"
by (cs_concl cs_intro: cat_arrow_cs_intros)
then have inv_gf: "is_inverse β ((g ββ©Aβββ f)Β―β©Cβββ) (g ββ©Aβββ f)"
by (intro cat_the_inverse_is_inverse)
from assms have "is_inverse β (gΒ―β©Cβββ) g" "is_inverse β (fΒ―β©Cβββ) f"
by (auto intro: cat_the_inverse_is_inverse)
with category_axioms assms have
"is_inverse β (fΒ―β©Cβββ ββ©Aβββ gΒ―β©Cβββ) (g ββ©Aβββ f)"
by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros)
from inv_gf this show "(g ββ©Aβββ f)Β―β©Cβββ = fΒ―β©Cβββ ββ©Aβββ gΒ―β©Cβββ"
by (meson cat_is_inverse_eq)
qed
lemmas [cat_cs_simps] = category.cat_Comp_the_inverse
lemma (in category) cat_the_inverse_Comp_CId:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows cat_the_inverse_Comp_CId_left: "fΒ―β©Cβββ ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
and cat_the_inverse_Comp_CId_right: "f ββ©Aβββ fΒ―β©Cβββ = ββ¦CIdβ¦β¦bβ¦"
proof-
from assms show "fΒ―β©Cβββ ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: is_inverse_Comp_CId_left
cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
)
from assms show "f ββ©Aβββ fΒ―β©Cβββ = ββ¦CIdβ¦β¦bβ¦"
by
(
cs_concl
cs_simp: is_inverse_Comp_CId_right
cs_intro: cat_the_inverse_is_inverse cat_arrow_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_the_inverse_Comp_CId
lemma (in category) cat_the_inverse_the_inverse:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "(fΒ―β©Cβββ)Β―β©Cβββ = f"
proof-
from assms have
"(fΒ―β©Cβββ)Β―β©Cβββ = (fΒ―β©Cβββ)Β―β©Cβββ ββ©Aβββ fΒ―β©Cβββ ββ©Aβββ f"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
)
also from assms have "β¦ = f"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
)
finally show ?thesis .
qed
lemmas [cat_cs_simps] = category.cat_the_inverse_the_inverse
subsectionβΉIsomorphic objectsβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
definition obj_iso :: "V β V β V β bool"
where "obj_iso β a b β· (βf. f : a β¦β©iβ©sβ©oβββ b)"
syntax "_obj_iso" :: "V β V β V β bool" (βΉ(_/ ββ©oβ©bβ©jΔ± _)βΊ [55, 56] 55)
translations "a ββ©oβ©bβ©jβββ b" β "CONST obj_iso β a b"
textβΉRules.βΊ
lemma obj_isoI:
assumes "f : a β¦β©iβ©sβ©oβββ b"
shows "a ββ©oβ©bβ©jβββ b"
using assms unfolding obj_iso_def by auto
lemma obj_isoD[dest]:
assumes "a ββ©oβ©bβ©jβββ b"
shows "βf. f : a β¦β©iβ©sβ©oβββ b"
using assms unfolding obj_iso_def by auto
lemma obj_isoE[elim!]:
assumes "a ββ©oβ©bβ©jβββ b"
obtains f where "f : a β¦β©iβ©sβ©oβββ b"
using assms by auto
textβΉElementary properties.βΊ
lemma (in category) op_cat_obj_iso[cat_op_simps]:
"a ββ©oβ©bβ©jβop_cat ββ b = b ββ©oβ©bβ©jβββ a"
unfolding obj_iso_def cat_op_simps ..
lemmas [cat_op_simps] = category.op_cat_obj_iso
lemmas [cat_op_intros] = category.op_cat_obj_iso[THEN iffD2]
textβΉEquivalence relation.βΊ
lemma (in category) cat_obj_iso_refl:
assumes "a ββ©β ββ¦Objβ¦"
shows "a ββ©oβ©bβ©jβββ a"
using assms by (auto intro: obj_isoI cat_arrow_cs_intros)
lemma (in category) cat_obj_iso_sym[sym]:
assumes "a ββ©oβ©bβ©jβββ b"
shows "b ββ©oβ©bβ©jβββ a"
using assms
by (elim obj_isoE is_arr_isomorphismE)
(metis obj_iso_def cat_is_inverse_is_arr_isomorphism)
lemma (in category) cat_obj_iso_trans[trans]:
assumes "a ββ©oβ©bβ©jβββ b" and "b ββ©oβ©bβ©jβββ c"
shows "a ββ©oβ©bβ©jβββ c"
using assms by (auto intro: cat_Comp_is_arr_isomorphism obj_isoI)
subsectionβΉTerminal object and initial objectβΊ
lemma (in category) cat_obj_terminal_CId:
assumes "obj_terminal β a" and "f : a β¦βββ a"
shows "ββ¦CIdβ¦β¦aβ¦ = f"
using assms by (elim obj_terminalE) (metis cat_CId_is_arr)
lemma (in category) cat_obj_initial_CId:
assumes "obj_initial β a" and "f : a β¦βββ a"
shows "ββ¦CIdβ¦β¦aβ¦ = f"
using assms
by (rule category.cat_obj_terminal_CId[OF category_op, unfolded cat_op_simps])
lemma (in category) cat_obj_terminal_obj_iso:
assumes "obj_terminal β a" and "obj_terminal β a'"
shows "a ββ©oβ©bβ©jβββ a'"
proof-
from assms obtain f where f: "f : a β¦βββ a'" by auto
from assms obtain f' where f': "f' : a' β¦βββ a" by auto
from f f' cat_obj_terminal_CId cat_Comp_is_arr
have f'f: "is_inverse β f' f"
by (intro is_inverseI[OF f' f]) (metis assms(1), metis assms(2))
with f show ?thesis by (cs_concl cs_intro: obj_isoI is_arr_isomorphismI)
qed
lemma (in category) cat_obj_initial_obj_iso:
assumes "obj_initial β a" and "obj_initial β a'"
shows "a' ββ©oβ©bβ©jβββ a"
proof-
interpret op: category Ξ± βΉop_cat ββΊ by (auto intro: cat_cs_intros)
from assms show ?thesis
by (rule op.cat_obj_terminal_obj_iso[unfolded cat_op_simps])
qed
subsectionβΉNull objectβΊ
lemma (in category) cat_obj_null_obj_iso:
assumes "obj_null β z" and "obj_null β z'"
shows "z ββ©oβ©bβ©jβββ z'"
using assms by (simp add: cat_obj_terminal_obj_iso obj_nullD(2))
subsectionβΉGroupoidβΊ
textβΉSee Chapter I-5 in \cite{mac_lane_categories_2010}.βΊ
locale groupoid = category Ξ± β for Ξ± β +
assumes grpd_is_arr_isomorphism: "f : a β¦βββ b βΉ f : a β¦β©iβ©sβ©oβββ b"
textβΉRules.βΊ
mk_ide rf groupoid_def[unfolded groupoid_axioms_def]
|intro groupoidI|
|dest groupoidD[dest]|
|elim groupoidE[elim]|
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Small_Category
sectionβΉSmallness for categoriesβΊ
theory CZH_ECAT_Small_Category
imports
CZH_Foundations.CZH_SMC_Small_Semicategory
CZH_ECAT_Category
begin
subsectionβΉBackgroundβΊ
textβΉ
An explanation of the methodology chosen for the exposition of all
matters related to the size of the categories and associated entities
is given in the first installment of this work.
βΊ
named_theorems cat_small_cs_simps
named_theorems cat_small_cs_intros
subsectionβΉTiny categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale tiny_category = π΅ Ξ± + vfsequence β + CId: vsv βΉββ¦CIdβ¦βΊ for Ξ± β +
assumes tiny_cat_length[cat_cs_simps]: "vcard β = 6β©β"
and tiny_cat_tiny_semicategory[slicing_intros]:
"tiny_semicategory Ξ± (cat_smc β)"
and tiny_cat_CId_vdomain[cat_cs_simps]: "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and tiny_cat_CId_is_arr[cat_cs_intros]:
"a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and tiny_cat_CId_left_left[cat_cs_simps]:
"f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and tiny_cat_CId_right_left[cat_cs_simps]:
"f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
lemmas [slicing_intros] = tiny_category.tiny_cat_tiny_semicategory
textβΉRules.βΊ
lemma (in tiny_category) tiny_category_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "tiny_category Ξ±' β"
unfolding assms by (rule tiny_category_axioms)
mk_ide rf tiny_category_def[unfolded tiny_category_axioms_def]
|intro tiny_categoryI|
|dest tiny_categoryD[dest]|
|elim tiny_categoryE[elim]|
lemma tiny_categoryI':
assumes "category Ξ± β" and "ββ¦Objβ¦ ββ©β Vset Ξ±" and "ββ¦Arrβ¦ ββ©β Vset Ξ±"
shows "tiny_category Ξ± β"
proof-
interpret category Ξ± β by (rule assms(1))
show ?thesis
proof(intro tiny_categoryI)
from assms show "tiny_semicategory Ξ± (cat_smc β)"
by (intro tiny_semicategoryI') (auto simp: slicing_simps)
qed (auto simp: vfsequence_axioms cat_cs_simps cat_cs_intros)
qed
lemma tiny_categoryI'':
assumes "π΅ Ξ±"
and "vfsequence β"
and "vcard β = 6β©β"
and "vsv (ββ¦Domβ¦)"
and "vsv (ββ¦Codβ¦)"
and "vsv (ββ¦Compβ¦)"
and "vsv (ββ¦CIdβ¦)"
and "πβ©β (ββ¦Domβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Domβ¦) ββ©β ββ¦Objβ¦"
and "πβ©β (ββ¦Codβ¦) = ββ¦Arrβ¦"
and "ββ©β (ββ¦Codβ¦) ββ©β ββ¦Objβ¦"
and "βgf. gf ββ©β πβ©β (ββ¦Compβ¦) β·
(βg f b c a. gf = [g, f]β©β β§ g : b β¦βββ c β§ f : a β¦βββ b)"
and "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and "βb c g a f. β¦ g : b β¦βββ c; f : a β¦βββ b β§ βΉ g ββ©Aβββ f : a β¦βββ c"
and "βc d h b g a f. β¦ h : c β¦βββ d; g : b β¦βββ c; f : a β¦βββ b β§ βΉ
(h ββ©Aβββ g) ββ©Aβββ f = h ββ©Aβββ (g ββ©Aβββ f)"
and "βa. a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and "βa b f. f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and "βb c f. f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
and "ββ¦Objβ¦ ββ©β Vset Ξ±"
and "ββ¦Arrβ¦ ββ©β Vset Ξ±"
shows "tiny_category Ξ± β"
by (intro tiny_categoryI tiny_semicategoryI'', unfold slicing_simps)
(simp_all add: cat_smc_def nat_omega_simps assms)
textβΉSlicing.βΊ
context tiny_category
begin
interpretation smc: tiny_semicategory Ξ± βΉcat_smc ββΊ
by (rule tiny_cat_tiny_semicategory)
lemmas_with [unfolded slicing_simps]:
tiny_cat_semicategory = smc.semicategory_axioms
and tiny_cat_Obj_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Obj_in_Vset
and tiny_cat_Arr_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Arr_in_Vset
and tiny_cat_Dom_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Dom_in_Vset
and tiny_cat_Cod_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Cod_in_Vset
and tiny_cat_Comp_in_Vset[cat_small_cs_intros] = smc.tiny_smc_Comp_in_Vset
end
textβΉElementary properties.βΊ
sublocale tiny_category β category
by (rule categoryI)
(
auto simp:
vfsequence_axioms tiny_cat_semicategory cat_cs_intros cat_cs_simps
)
lemmas (in tiny_category) tiny_dg_category = category_axioms
lemmas [cat_small_cs_intros] = tiny_category.tiny_dg_category
textβΉSize.βΊ
lemma (in tiny_category) tiny_cat_CId_in_Vset: "ββ¦CIdβ¦ ββ©β Vset Ξ±"
proof-
from tiny_cat_Obj_in_Vset have "πβ©β (ββ¦CIdβ¦) ββ©β Vset Ξ±"
by (simp add: tiny_cat_Obj_in_Vset cat_cs_simps)
moreover from tiny_cat_Arr_in_Vset cat_CId_vrange tiny_cat_Arr_in_Vset have
"ββ©β (ββ¦CIdβ¦) ββ©β Vset Ξ±"
by auto
ultimately show ?thesis by (blast intro: π΅_Limit_Ξ±Ο)
qed
lemma (in tiny_category) tiny_cat_in_Vset: "β ββ©β Vset Ξ±"
proof-
note [cat_cs_intros] =
tiny_cat_Obj_in_Vset
tiny_cat_Arr_in_Vset
tiny_cat_Dom_in_Vset
tiny_cat_Cod_in_Vset
tiny_cat_Comp_in_Vset
tiny_cat_CId_in_Vset
show ?thesis by (subst cat_def) (cs_concl cs_intro: cat_cs_intros V_cs_intros)
qed
lemma tiny_category[simp]: "small {β. tiny_category Ξ± β}"
proof(rule down)
show "{β. tiny_category Ξ± β} β elts (set {β. category Ξ± β})"
by (auto intro: cat_small_cs_intros)
qed
lemma small_categories_vsubset_Vset: "set {β. tiny_category Ξ± β} ββ©β Vset Ξ±"
by (rule vsubsetI) (simp_all add: tiny_category.tiny_cat_in_Vset)
lemma (in category) cat_tiny_category_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² β"
proof(intro tiny_categoryI)
show "tiny_semicategory Ξ² (cat_smc β)"
by
(
rule semicategory.smc_tiny_semicategory_if_ge_Limit,
rule cat_semicategory;
intro assms
)
qed (auto simp: assms(1) cat_cs_simps cat_cs_intros vfsequence_axioms)
subsubsectionβΉOpposite tiny categoryβΊ
lemma (in tiny_category) tiny_category_op: "tiny_category Ξ± (op_cat β)"
by (intro tiny_categoryI')
(auto simp: cat_op_simps cat_cs_intros cat_small_cs_intros)
lemmas tiny_category_op[cat_op_intros] = tiny_category.tiny_category_op
subsectionβΉFinite categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
A definition of a finite category can be found in nLab
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/finite+category}
}.
βΊ
locale finite_category = π΅ Ξ± + vfsequence β + CId: vsv βΉββ¦CIdβ¦βΊ for Ξ± β +
assumes fin_cat_length[cat_cs_simps]: "vcard β = 6β©β"
and fin_cat_finite_semicategory[slicing_intros]:
"finite_semicategory Ξ± (cat_smc β)"
and fin_cat_CId_vdomain[cat_cs_simps]: "πβ©β (ββ¦CIdβ¦) = ββ¦Objβ¦"
and fin_cat_CId_is_arr[cat_cs_intros]:
"a ββ©β ββ¦Objβ¦ βΉ ββ¦CIdβ¦β¦aβ¦ : a β¦βββ a"
and fin_cat_CId_left_left[cat_cs_simps]:
"f : a β¦βββ b βΉ ββ¦CIdβ¦β¦bβ¦ ββ©Aβββ f = f"
and fin_cat_CId_right_left[cat_cs_simps]:
"f : b β¦βββ c βΉ f ββ©Aβββ ββ¦CIdβ¦β¦bβ¦ = f"
lemmas [slicing_intros] = finite_category.fin_cat_finite_semicategory
textβΉRules.βΊ
lemma (in finite_category) fin_category_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "finite_category Ξ±' β"
unfolding assms by (rule finite_category_axioms)
mk_ide rf finite_category_def[unfolded finite_category_axioms_def]
|intro finite_categoryI|
|dest finite_categoryD[dest]|
|elim finite_categoryE[elim]|
lemma finite_categoryI':
assumes "category Ξ± β" and "vfinite (ββ¦Objβ¦)" and "vfinite (ββ¦Arrβ¦)"
shows "finite_category Ξ± β"
proof-
interpret category Ξ± β by (rule assms(1))
show ?thesis
proof(intro finite_categoryI)
from assms show "finite_semicategory Ξ± (cat_smc β)"
by (intro finite_semicategoryI') (auto simp: slicing_simps)
qed (auto simp: vfsequence_axioms cat_cs_simps cat_cs_intros)
qed
lemma finite_categoryI'':
assumes "tiny_category Ξ± β" and "vfinite (ββ¦Objβ¦)" and "vfinite (ββ¦Arrβ¦)"
shows "finite_category Ξ± β"
using assms by (intro finite_categoryI') (auto intro: cat_small_cs_intros)
textβΉSlicing.βΊ
context finite_category
begin
interpretation smc: finite_semicategory Ξ± βΉcat_smc ββΊ
by (rule fin_cat_finite_semicategory)
lemmas_with [unfolded slicing_simps]:
fin_cat_tiny_semicategory = smc.tiny_semicategory_axioms
and fin_smc_Obj_vfinite[cat_small_cs_intros] = smc.fin_smc_Obj_vfinite
and fin_smc_Arr_vfinite[cat_small_cs_intros] = smc.fin_smc_Arr_vfinite
end
textβΉElementary properties.βΊ
sublocale finite_category β tiny_category
by (rule tiny_categoryI)
(
auto
simp: vfsequence_axioms
intro:
cat_cs_intros cat_cs_simps cat_small_cs_intros
finite_category.fin_cat_tiny_semicategory
)
lemmas (in finite_category) fin_cat_tiny_category = tiny_category_axioms
lemmas [cat_small_cs_intros] = finite_category.fin_cat_tiny_category
lemma (in finite_category) fin_cat_in_Vset: "β ββ©β Vset Ξ±"
by (rule tiny_cat_in_Vset)
textβΉSize.βΊ
lemma small_finite_categories[simp]: "small {β. finite_category Ξ± β}"
proof(rule down)
show "{β. finite_category Ξ± β} β elts (set {β. tiny_category Ξ± β})"
by (auto intro: cat_small_cs_intros)
qed
lemma small_finite_categories_vsubset_Vset:
"set {β. finite_category Ξ± β} ββ©β Vset Ξ±"
by (rule vsubsetI) (simp_all add: finite_category.fin_cat_in_Vset)
subsubsectionβΉOpposite finite categoryβΊ
lemma (in finite_category) finite_category_op: "finite_category Ξ± (op_cat β)"
by (intro finite_categoryI', unfold cat_op_simps)
(auto simp: cat_cs_intros cat_small_cs_intros)
lemmas finite_category_op[cat_op_intros] = finite_category.finite_category_op
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Functor
sectionβΉFunctorβΊ
theory CZH_ECAT_Functor
imports
CZH_ECAT_Category
CZH_Foundations.CZH_SMC_Semifunctor
begin
subsectionβΉBackgroundβΊ
named_theorems cf_cs_simps
named_theorems cf_cs_intros
named_theorems cat_cn_cs_simps
named_theorems cat_cn_cs_intros
lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros
subsubsectionβΉSlicingβΊ
definition cf_smcf :: "V β V"
where "cf_smcf β =
[ββ¦ObjMapβ¦, ββ¦ArrMapβ¦, cat_smc (ββ¦HomDomβ¦), cat_smc (ββ¦HomCodβ¦)]β©β"
textβΉComponents.βΊ
lemma cf_smcf_components:
shows [slicing_simps]: "cf_smcf πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and [slicing_simps]: "cf_smcf πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
and [slicing_commute]: "cf_smcf πβ¦HomDomβ¦ = cat_smc (πβ¦HomDomβ¦)"
and [slicing_commute]: "cf_smcf πβ¦HomCodβ¦ = cat_smc (πβ¦HomCodβ¦)"
unfolding cf_smcf_def dghm_field_simps by (auto simp: nat_omega_simps)
subsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.βΊ
locale is_functor =
π΅ Ξ± + vfsequence π + HomDom: category Ξ± π + HomCod: category Ξ± π
for Ξ± π π
π +
assumes cf_length[cat_cs_simps]: "vcard π = 4β©β"
and cf_is_semifunctor[slicing_intros]:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π
"
and cf_HomDom[cat_cs_simps]: "πβ¦HomDomβ¦ = π"
and cf_HomCod[cat_cs_simps]: "πβ¦HomCodβ¦ = π
"
and cf_ObjMap_CId[cat_cs_intros]:
"c ββ©β πβ¦Objβ¦ βΉ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦"
syntax "_is_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©CβΞ±β π
" β "CONST is_functor Ξ± π π
π"
abbreviation (input) is_cn_cf :: "V β V β V β V β bool"
where "is_cn_cf Ξ± π π
π β‘ π : op_cat π β¦β¦β©CβΞ±β π
"
syntax "_is_cn_cf" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β©Cβ¦β¦Δ± _)βΊ [51, 51, 51] 51)
translations "π : π β©Cβ¦β¦βΞ±β π
" β "CONST is_cn_cf Ξ± π π
π"
abbreviation all_cfs :: "V β V"
where "all_cfs Ξ± β‘ set {π. βπ π
. π : π β¦β¦β©CβΞ±β π
}"
abbreviation cfs :: "V β V β V β V"
where "cfs Ξ± π π
β‘ set {π. π : π β¦β¦β©CβΞ±β π
}"
lemmas [cat_cs_simps] =
is_functor.cf_length
is_functor.cf_HomDom
is_functor.cf_HomCod
is_functor.cf_ObjMap_CId
lemma cn_cf_ObjMap_CId[cat_cn_cs_simps]:
assumes "π : π β©Cβ¦β¦βΞ±β π
" and "c ββ©β πβ¦Objβ¦"
shows "πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦"
proof-
interpret is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(1))
from assms(2) have c: "c ββ©β op_cat πβ¦Objβ¦" unfolding cat_op_simps by simp
show ?thesis by (rule cf_ObjMap_CId[OF c, unfolded cat_op_simps])
qed
lemma (in is_functor) cf_is_semifunctor':
assumes "π' = cat_smc π" and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©CβΞ±β π
'"
unfolding assms by (rule cf_is_semifunctor)
lemmas [slicing_intros] = is_functor.cf_is_semifunctor'
lemma cn_smcf_comp_is_semifunctor:
assumes "π : π β©Cβ¦β¦βΞ±β π
"
shows "cf_smcf π : cat_smc π β©Sβ©Mβ©Cβ¦β¦βΞ±βcat_smc π
"
using assms
unfolding slicing_simps slicing_commute
by (rule is_functor.cf_is_semifunctor)
lemma cn_smcf_comp_is_semifunctor'[slicing_intros]:
assumes "π : π β©Cβ¦β¦βΞ±β π
"
and "π' = op_smc (cat_smc π)"
and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©CβΞ±β π
'"
using assms(1) unfolding assms(2,3) by (rule cn_smcf_comp_is_semifunctor)
textβΉRules.βΊ
lemma (in is_functor) is_functor_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©CβΞ±'β π
'"
unfolding assms by (rule is_functor_axioms)
mk_ide rf is_functor_def[unfolded is_functor_axioms_def]
|intro is_functorI|
|dest is_functorD[dest]|
|elim is_functorE[elim]|
lemmas [cat_cs_intros] = is_functorD(3,4)
lemma is_functorI':
assumes "π΅ Ξ±"
and "vfsequence π"
and "category Ξ± π"
and "category Ξ± π
"
and "vcard π = 4β©β"
and "πβ¦HomDomβ¦ = π"
and "πβ¦HomCodβ¦ = π
"
and "vsv (πβ¦ObjMapβ¦)"
and "vsv (πβ¦ArrMapβ¦)"
and "πβ©β (πβ¦ObjMapβ¦) = πβ¦Objβ¦"
and "ββ©β (πβ¦ObjMapβ¦) ββ©β π
β¦Objβ¦"
and "πβ©β (πβ¦ArrMapβ¦) = πβ¦Arrβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and "βb c g a f. β¦ g : b β¦βπβ c; f : a β¦βπβ b β§ βΉ
πβ¦ArrMapβ¦β¦g ββ©Aβπβ fβ¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦"
and "(βc. c ββ©β πβ¦Objβ¦ βΉ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦)"
shows "π : π β¦β¦β©CβΞ±β π
"
by
(
intro is_functorI is_semifunctorI',
unfold cf_smcf_components slicing_simps
)
(simp_all add: assms cf_smcf_def nat_omega_simps category.cat_semicategory)
lemma is_functorD':
assumes "π : π β¦β¦β©CβΞ±β π
"
shows "π΅ Ξ±"
and "vfsequence π"
and "category Ξ± π"
and "category Ξ± π
"
and "vcard π = 4β©β"
and "πβ¦HomDomβ¦ = π"
and "πβ¦HomCodβ¦ = π
"
and "vsv (πβ¦ObjMapβ¦)"
and "vsv (πβ¦ArrMapβ¦)"
and "πβ©β (πβ¦ObjMapβ¦) = πβ¦Objβ¦"
and "ββ©β (πβ¦ObjMapβ¦) ββ©β π
β¦Objβ¦"
and "πβ©β (πβ¦ArrMapβ¦) = πβ¦Arrβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and "βb c g a f. β¦ g : b β¦βπβ c; f : a β¦βπβ b β§ βΉ
πβ¦ArrMapβ¦β¦g ββ©Aβπβ fβ¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦"
and "(βc. c ββ©β πβ¦Objβ¦ βΉ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦)"
by
(
simp_all add:
is_functorD(2-9)[OF assms]
is_semifunctorD'[OF is_functorD(6)[OF assms], unfolded slicing_simps]
)
lemma is_functorE':
assumes "π : π β¦β¦β©CβΞ±β π
"
obtains "π΅ Ξ±"
and "vfsequence π"
and "category Ξ± π"
and "category Ξ± π
"
and "vcard π = 4β©β"
and "πβ¦HomDomβ¦ = π"
and "πβ¦HomCodβ¦ = π
"
and "vsv (πβ¦ObjMapβ¦)"
and "vsv (πβ¦ArrMapβ¦)"
and "πβ©β (πβ¦ObjMapβ¦) = πβ¦Objβ¦"
and "ββ©β (πβ¦ObjMapβ¦) ββ©β π
β¦Objβ¦"
and "πβ©β (πβ¦ArrMapβ¦) = πβ¦Arrβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and "βb c g a f. β¦ g : b β¦βπβ c; f : a β¦βπβ b β§ βΉ
πβ¦ArrMapβ¦β¦g ββ©Aβπβ fβ¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦"
and "(βc. c ββ©β πβ¦Objβ¦ βΉ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦)"
using assms by (simp add: is_functorD')
textβΉA functor is a semifunctor.βΊ
context is_functor
begin
interpretation smcf: is_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule cf_is_semifunctor)
sublocale ObjMap: vsv βΉπβ¦ObjMapβ¦βΊ
by (rule smcf.ObjMap.vsv_axioms[unfolded slicing_simps])
sublocale ArrMap: vsv βΉπβ¦ArrMapβ¦βΊ
by (rule smcf.ArrMap.vsv_axioms[unfolded slicing_simps])
lemmas_with [unfolded slicing_simps]:
cf_ObjMap_vsv = smcf.smcf_ObjMap_vsv
and cf_ArrMap_vsv = smcf.smcf_ArrMap_vsv
and cf_ObjMap_vdomain[cat_cs_simps] = smcf.smcf_ObjMap_vdomain
and cf_ObjMap_vrange = smcf.smcf_ObjMap_vrange
and cf_ArrMap_vdomain[cat_cs_simps] = smcf.smcf_ArrMap_vdomain
and cf_ArrMap_is_arr = smcf.smcf_ArrMap_is_arr
and cf_ArrMap_is_arr''[cat_cs_intros] = smcf.smcf_ArrMap_is_arr''
and cf_ArrMap_is_arr'[cat_cs_intros] = smcf.smcf_ArrMap_is_arr'
and cf_ObjMap_app_in_HomCod_Obj[cat_cs_intros] =
smcf.smcf_ObjMap_app_in_HomCod_Obj
and cf_ArrMap_vrange = smcf.smcf_ArrMap_vrange
and cf_ArrMap_app_in_HomCod_Arr[cat_cs_intros] =
smcf.smcf_ArrMap_app_in_HomCod_Arr
and cf_ObjMap_vsubset_Vset = smcf.smcf_ObjMap_vsubset_Vset
and cf_ArrMap_vsubset_Vset = smcf.smcf_ArrMap_vsubset_Vset
and cf_ObjMap_in_Vset = smcf.smcf_ObjMap_in_Vset
and cf_ArrMap_in_Vset = smcf.smcf_ArrMap_in_Vset
and cf_is_semifunctor_if_ge_Limit = smcf.smcf_is_semifunctor_if_ge_Limit
and cf_is_arr_HomCod = smcf.smcf_is_arr_HomCod
and cf_vimage_dghm_ArrMap_vsubset_Hom =
smcf.smcf_vimage_dghm_ArrMap_vsubset_Hom
lemmas_with [unfolded slicing_simps]:
cf_ArrMap_Comp = smcf.smcf_ArrMap_Comp
end
lemmas [cat_cs_simps] =
is_functor.cf_ObjMap_vdomain
is_functor.cf_ArrMap_vdomain
is_functor.cf_ArrMap_Comp
lemmas [cat_cs_intros] =
is_functor.cf_ObjMap_app_in_HomCod_Obj
is_functor.cf_ArrMap_app_in_HomCod_Arr
is_functor.cf_ArrMap_is_arr'
textβΉElementary properties.βΊ
lemma cn_cf_ArrMap_Comp[cat_cn_cs_simps]:
assumes "category Ξ± π"
and "π : π β©Cβ¦β¦βΞ±β π
"
and "g : c β¦βπβ b"
and "f : b β¦βπβ a"
shows "πβ¦ArrMapβ¦β¦f ββ©Aβπβ gβ¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule cn_smcf_ArrMap_Comp
[
OF
π.cat_semicategory
π.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_simps,
OF assms(3,4)
]
)
qed
lemma cf_eqI:
assumes "π : π β¦β¦β©CβΞ±β π
"
and "π : β β¦β¦β©CβΞ±β π"
and "πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
and "π = β"
and "π
= π"
shows "π = π"
proof(rule vsv_eqI)
interpret L: is_functor Ξ± π π
π by (rule assms(1))
interpret R: is_functor Ξ± β π π by (rule assms(2))
from assms(1) show "vsv π" by auto
from assms(2) show "vsv π" by auto
have dom: "πβ©β π = 4β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
show "πβ©β π = πβ©β π" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
from assms(5,6) have sup: "πβ¦HomDomβ¦ = πβ¦HomDomβ¦" "πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
by (simp_all add: cat_cs_simps)
show "a ββ©β πβ©β π βΉ πβ¦aβ¦ = πβ¦aβ¦" for a
by (unfold dom, elim_in_numeral, insert assms(3,4) sup)
(auto simp: dghm_field_simps)
qed
lemma cf_smcf_eqI:
assumes "π : π β¦β¦β©CβΞ±β π
"
and "π : β β¦β¦β©CβΞ±β π"
and "π = β"
and "π
= π"
and "cf_smcf π = cf_smcf π"
shows "π = π"
proof(rule cf_eqI)
from assms(5) have
"cf_smcf πβ¦ObjMapβ¦ = cf_smcf πβ¦ObjMapβ¦"
"cf_smcf πβ¦ArrMapβ¦ = cf_smcf πβ¦ArrMapβ¦"
by simp_all
then show "πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦" "πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
unfolding slicing_simps by simp_all
qed (auto intro: assms(1,2) simp: assms(3-5))
lemma (in is_functor) cf_def: "π = [πβ¦ObjMapβ¦, πβ¦ArrMapβ¦, πβ¦HomDomβ¦, πβ¦HomCodβ¦]β©β"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β π = 4β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
have dom_rhs: "πβ©β [πβ¦Objβ¦, πβ¦Arrβ¦, πβ¦Domβ¦, πβ¦Codβ¦]β©β = 4β©β"
by (simp add: nat_omega_simps)
then show "πβ©β π = πβ©β [πβ¦ObjMapβ¦, πβ¦ArrMapβ¦, πβ¦HomDomβ¦, πβ¦HomCodβ¦]β©β"
unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
show "a ββ©β πβ©β π βΉ πβ¦aβ¦ = [πβ¦ObjMapβ¦, πβ¦ArrMapβ¦, πβ¦HomDomβ¦, πβ¦HomCodβ¦]β©ββ¦aβ¦"
for a
by (unfold dom_lhs, elim_in_numeral, unfold dghm_field_simps)
(simp_all add: nat_omega_simps)
qed (auto simp: vsv_axioms)
textβΉSize.βΊ
lemma (in is_functor) cf_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π ββ©β Vset Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
note [cat_cs_intros] =
cf_ObjMap_in_Vset
cf_ArrMap_in_Vset
HomDom.cat_in_Vset
HomCod.cat_in_Vset
from assms(2) show ?thesis
by (subst cf_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed
lemma (in is_functor) cf_is_functor_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π : π β¦β¦β©CβΞ²β π
"
by (rule is_functorI)
(
auto simp:
cat_cs_simps
assms
vfsequence_axioms
cf_is_semifunctor_if_ge_Limit
HomDom.cat_category_if_ge_Limit
HomCod.cat_category_if_ge_Limit
intro: cat_cs_intros
)
lemma small_all_cfs[simp]: "small {π. βπ π
. π : π β¦β¦β©CβΞ±β π
}"
proof(cases βΉπ΅ Ξ±βΊ)
case True
from is_functor.cf_in_Vset show ?thesis
by (intro down[of _ βΉVset (Ξ± + Ο)βΊ])
(auto simp: True π΅.π΅_Limit_Ξ±Ο π΅.π΅_Ο_Ξ±Ο π΅.intro π΅.π΅_Ξ±_Ξ±Ο)
next
case False
then have "{π. βπ π
. π : π β¦β¦β©CβΞ±β π
} = {}" by auto
then show ?thesis by simp
qed
lemma (in is_functor) cf_in_Vset_7: "π ββ©β Vset (Ξ± + 7β©β)"
proof-
note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
cf_ObjMap_vsubset_Vset
cf_ArrMap_vsubset_Vset
from HomDom.cat_category_in_Vset_4 have [cat_cs_intros]:
"π ββ©β Vset (succ (succ (succ (succ Ξ±))))"
by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
from HomCod.cat_category_in_Vset_4 have [cat_cs_intros]:
"π
ββ©β Vset (succ (succ (succ (succ Ξ±))))"
by (succ_of_numeral) (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
show ?thesis
by (subst cf_def, succ_of_numeral)
(
cs_concl
cs_simp: plus_V_succ_right V_cs_simps cat_cs_simps
cs_intro: cat_cs_intros V_cs_intros
)
qed
lemma (in π΅) all_cfs_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "all_cfs Ξ± ββ©β Vset Ξ²"
proof(rule vsubset_in_VsetI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "all_cfs Ξ± ββ©β Vset (Ξ± + 7β©β)"
proof(intro vsubsetI)
fix π assume "π ββ©β all_cfs Ξ±"
then obtain π π
where π: "π : π β¦β¦β©CβΞ±β π
" by clarsimp
interpret is_functor Ξ± π π
π using π by simp
show "π ββ©β Vset (Ξ± + 7β©β)" by (rule cf_in_Vset_7)
qed
from assms(2) show "Vset (Ξ± + 7β©β) ββ©β Vset Ξ²"
by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed
lemma small_cfs[simp]: "small {π. π : π β¦β¦β©CβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π
. π : π β¦β¦β©CβΞ±β π
}βΊ]) auto
subsectionβΉOpposite functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-2 in \cite{mac_lane_categories_2010}.βΊ
definition op_cf :: "V β V"
where "op_cf π =
[πβ¦ObjMapβ¦, πβ¦ArrMapβ¦, op_cat (πβ¦HomDomβ¦), op_cat (πβ¦HomCodβ¦)]β©β"
textβΉComponents.βΊ
lemma op_cf_components[cat_op_simps]:
shows "op_cf πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "op_cf πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
and "op_cf πβ¦HomDomβ¦ = op_cat (πβ¦HomDomβ¦)"
and "op_cf πβ¦HomCodβ¦ = op_cat (πβ¦HomCodβ¦)"
unfolding op_cf_def dghm_field_simps by (auto simp: nat_omega_simps)
textβΉSlicing.βΊ
lemma cf_smcf_op_cf[slicing_commute]: "op_smcf (cf_smcf π) = cf_smcf (op_cf π)"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (op_smcf (cf_smcf π)) = 4β©β"
unfolding op_smcf_def by (auto simp: nat_omega_simps)
have dom_rhs: "πβ©β (cf_smcf (op_cf π)) = 4β©β"
unfolding cf_smcf_def by (auto simp: nat_omega_simps)
show "πβ©β (op_smcf (cf_smcf π)) = πβ©β (cf_smcf (op_cf π))"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (op_smcf (cf_smcf π)) βΉ
op_smcf (cf_smcf π)β¦aβ¦ = cf_smcf (op_cf π)β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cf_smcf_def op_cf_def op_smcf_def dghm_field_simps
)
(auto simp: nat_omega_simps slicing_commute)
qed (auto simp: cf_smcf_def op_smcf_def)
textβΉElementary properties.βΊ
lemma op_cf_vsv[cat_op_intros]: "vsv (op_cf π)" unfolding op_cf_def by auto
subsubsectionβΉFurther propertiesβΊ
lemma (in is_functor) is_functor_op: "op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat π
"
proof(intro is_functorI, unfold cat_op_simps)
show "vfsequence (op_cf π)" unfolding op_cf_def by simp
show "vcard (op_cf π) = 4β©β"
unfolding op_cf_def by (auto simp: nat_omega_simps)
fix c assume "c ββ©β πβ¦Objβ¦"
then show "πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦"
unfolding cat_op_simps by (auto intro: cat_cs_intros)
qed
(
auto simp:
cat_cs_simps
slicing_commute[symmetric]
is_semifunctor.is_semifunctor_op
cf_is_semifunctor
HomCod.category_op
HomDom.category_op
)
lemma (in is_functor) is_functor_op'[cat_op_intros]:
assumes "π' = op_cat π" and "π
' = op_cat π
"
shows "op_cf π : π' β¦β¦β©CβΞ±β π
'"
unfolding assms(1,2) by (rule is_functor_op)
lemmas is_functor_op[cat_op_intros] = is_functor.is_functor_op'
lemma (in is_functor) cf_op_cf_op_cf[cat_op_simps]: "op_cf (op_cf π) = π"
proof(rule cf_eqI[of Ξ± π π
_ π π
], unfold cat_op_simps)
show "op_cf (op_cf π) : π β¦β¦β©CβΞ±β π
"
by
(
metis
HomCod.cat_op_cat_op_cat
HomDom.cat_op_cat_op_cat
is_functor.is_functor_op
is_functor_op
)
qed (auto simp: cat_cs_intros)
lemmas cf_op_cf_op_cf[cat_op_simps] = is_functor.cf_op_cf_op_cf
lemma eq_op_cf_iff[cat_op_simps]:
assumes "π : π β¦β¦β©CβΞ±β π
" and "π : β β¦β¦β©CβΞ±β π"
shows "op_cf π = op_cf π β· π = π"
proof
interpret L: is_functor Ξ± π π
π by (rule assms(1))
interpret R: is_functor Ξ± β π π by (rule assms(2))
assume prems: "op_cf π = op_cf π"
show "π = π"
proof(rule cf_eqI[OF assms])
from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf show
"πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦" "πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
by metis+
from prems R.cf_op_cf_op_cf L.cf_op_cf_op_cf have
"πβ¦HomDomβ¦ = πβ¦HomDomβ¦" "πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
by auto
then show "π = β" "π
= π" by (simp_all add: cat_cs_simps)
qed
qed auto
subsectionβΉComposition of covariant functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
abbreviation (input) cf_comp :: "V β V β V" (infixl "ββ©Cβ©F" 55)
where "cf_comp β‘ dghm_comp"
textβΉSlicing.βΊ
lemma cf_smcf_smcf_comp[slicing_commute]:
"cf_smcf π ββ©Sβ©Mβ©Cβ©F cf_smcf π = cf_smcf (π ββ©Cβ©F π)"
unfolding dghm_comp_def cf_smcf_def dghm_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
lemma cf_comp_ObjMap_vsv[cat_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "vsv ((π ββ©Cβ©F π)β¦ObjMapβ¦)"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ObjMap_vsv
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π ββ©Cβ©F π)β¦ObjMapβ¦) = πβ¦Objβ¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ObjMap_vdomain
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ObjMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π ββ©Cβ©F π)β¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ObjMap_vrange
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ObjMap_app[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
" and [simp]: "a ββ©β πβ¦Objβ¦"
shows "(π ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ObjMap_app
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute,
OF assms(3)
]
)
qed
subsubsectionβΉArrow mapβΊ
lemma cf_comp_ArrMap_vsv[cat_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "vsv ((π ββ©Cβ©F π)β¦ArrMapβ¦)"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ArrMap_vsv
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π ββ©Cβ©F π)β¦ArrMapβ¦) = πβ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ArrMap_vdomain
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ArrMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π ββ©Cβ©F π)β¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ArrMap_vrange
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute
]
)
qed
lemma cf_comp_ArrMap_app[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
" and [simp]: "f ββ©β πβ¦Arrβ¦"
shows "(π ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_comp_ArrMap_app
[
OF L.cf_is_semifunctor R.cf_is_semifunctor,
unfolded slicing_simps slicing_commute,
OF assms(3)
]
)
qed
subsubsectionβΉFurther propertiesβΊ
lemma cf_comp_is_functorI[cat_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
proof-
interpret L: is_functor Ξ± π
β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
proof(rule is_functorI, unfold dghm_comp_components(3,4))
show "vfsequence (π ββ©Cβ©F π)" by (simp add: dghm_comp_def)
show "vcard (π ββ©Cβ©F π) = 4β©β"
unfolding dghm_comp_def by (simp add: nat_omega_simps)
show "cf_smcf (π ββ©Cβ©F π) : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
unfolding cf_smcf_smcf_comp[symmetric]
by (cs_concl cs_intro: smc_cs_intros slicing_intros cat_cs_intros)
fix c assume "c ββ©β πβ¦Objβ¦"
with assms show
"(π ββ©Cβ©F π)β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦(π ββ©Cβ©F π)β¦ObjMapβ¦β¦cβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cat_cs_simps intro: cat_cs_intros)
qed
lemma cf_comp_assoc[cat_cs_simps]:
assumes "β : β β¦β¦β©CβΞ±β π" and "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "(β ββ©Cβ©F π) ββ©Cβ©F π = β ββ©Cβ©F (π ββ©Cβ©F π)"
proof(rule cf_eqI[of Ξ± π π _ π π])
interpret β: is_functor Ξ± β π β by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_functor Ξ± π π
π by (rule assms(3))
from π.is_functor_axioms π.is_functor_axioms β.is_functor_axioms
show "β ββ©Cβ©F (π ββ©Cβ©F π) : π β¦β¦β©CβΞ±β π" and "β ββ©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β π"
by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed (simp_all add: dghm_comp_components vcomp_assoc)
textβΉThe opposite of the covariant composition of functors.βΊ
lemma op_cf_cf_comp[cat_op_simps]: "op_cf (π ββ©Cβ©F π) = op_cf π ββ©Cβ©F op_cf π"
unfolding dghm_comp_def op_cf_def dghm_field_simps
by (simp add: nat_omega_simps)
subsectionβΉComposition of contravariant functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee section 1.2 in \cite{bodo_categories_1970}.βΊ
definition cf_cn_comp :: "V β V β V" (infixl "β©Cβ©Fβ" 55)
where "π β©Cβ©Fβ π =
[
πβ¦ObjMapβ¦ ββ©β πβ¦ObjMapβ¦,
πβ¦ArrMapβ¦ ββ©β πβ¦ArrMapβ¦,
op_cat (πβ¦HomDomβ¦),
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_cn_comp_components:
shows "(π β©Cβ©Fβ π)β¦ObjMapβ¦ = πβ¦ObjMapβ¦ ββ©β πβ¦ObjMapβ¦"
and "(π β©Cβ©Fβ π)β¦ArrMapβ¦ = πβ¦ArrMapβ¦ ββ©β πβ¦ArrMapβ¦"
and [cat_cn_cs_simps]: "(π β©Cβ©Fβ π)β¦HomDomβ¦ = op_cat (πβ¦HomDomβ¦)"
and [cat_cn_cs_simps]: "(π β©Cβ©Fβ π)β¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_cn_comp_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cf_smcf_cf_cn_comp[slicing_commute]:
"cf_smcf π β©Sβ©Mβ©Cβ©Fβ cf_smcf π = cf_smcf (π β©Cβ©Fβ π)"
unfolding smcf_cn_comp_def cf_cn_comp_def cf_smcf_def
by (simp add: nat_omega_simps slicing_commute dghm_field_simps)
subsubsectionβΉObject map: two contravariant functorsβΊ
lemma cf_cn_comp_ObjMap_vsv[cat_cn_cs_intros]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "vsv ((π β©Cβ©Fβ π)β¦ObjMapβ¦)"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ObjMap_vsv
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ObjMap_vdomain[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "πβ©β ((π β©Cβ©Fβ π)β¦ObjMapβ¦) = πβ¦Objβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ObjMap_vdomain
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ObjMap_vrange:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "ββ©β ((π β©Cβ©Fβ π)β¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ObjMap_vrange
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ObjMap_app[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
" and "a ββ©β πβ¦Objβ¦"
shows "(π β©Cβ©Fβ π)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ObjMap_app
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps,
OF assms(3)
]
)
qed
subsubsectionβΉArrow map: two contravariant functorsβΊ
lemma cf_cn_comp_ArrMap_vsv[cat_cn_cs_intros]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "vsv ((π β©Cβ©Fβ π)β¦ArrMapβ¦)"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ArrMap_vsv
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ArrMap_vdomain[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "πβ©β ((π β©Cβ©Fβ π)β¦ArrMapβ¦) = πβ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ArrMap_vdomain
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ArrMap_vrange:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "ββ©β ((π β©Cβ©Fβ π)β¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ArrMap_vrange
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_comp_ArrMap_app[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
" and "a ββ©β πβ¦Arrβ¦"
shows "(π β©Cβ©Fβ π)β¦ArrMapβ¦β¦aβ¦ = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦aβ¦β¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_comp_ArrMap_app
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps,
OF assms(3)
]
)
qed
subsubsectionβΉObject map: contravariant and covariant functorβΊ
lemma cf_cn_cov_comp_ObjMap_vsv[cat_cn_cs_intros]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "vsv ((π β©Cβ©Fβ π)β¦ObjMapβ¦)"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ObjMap_vsv
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ObjMap_vdomain[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π β©Cβ©Fβ π)β¦ObjMapβ¦) = πβ¦Objβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ObjMap_vdomain
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ObjMap_vrange:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π β©Cβ©Fβ π)β¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ObjMap_vrange
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ObjMap_app[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
" and "a ββ©β πβ¦Objβ¦"
shows "(π β©Cβ©Fβ π)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ObjMap_app
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps,
OF assms(3)
]
)
qed
subsubsectionβΉArrow map: contravariant and covariant functorsβΊ
lemma cf_cn_cov_comp_ArrMap_vsv[cat_cn_cs_intros]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "vsv ((π β©Cβ©Fβ π)β¦ArrMapβ¦)"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ArrMap_vsv
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor[unfolded slicing_commute[symmetric]],
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ArrMap_vdomain[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π β©Cβ©Fβ π)β¦ArrMapβ¦) = πβ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ArrMap_vdomain
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ArrMap_vrange:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π β©Cβ©Fβ π)β¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ArrMap_vrange
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps
]
)
qed
lemma cf_cn_cov_comp_ArrMap_app[cat_cn_cs_simps]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
" and "a ββ©β πβ¦Arrβ¦"
shows "(π β©Cβ©Fβ π)β¦ArrMapβ¦β¦aβ¦ = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦aβ¦β¦"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by
(
rule smcf_cn_cov_comp_ArrMap_app
[
OF
L.cf_is_semifunctor[unfolded slicing_commute[symmetric]]
R.cf_is_semifunctor,
unfolded slicing_commute slicing_simps,
OF assms(3)
]
)
qed
subsubsectionβΉFurther propertiesβΊ
lemma cf_cn_comp_is_functorI[cat_cn_cs_intros]:
assumes "category Ξ± π" and "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "π β©Cβ©Fβ π : π β¦β¦β©CβΞ±β β"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(2))
interpret R: is_functor Ξ± βΉop_cat πβΊ π
π by (rule assms(3))
interpret π: category Ξ± π by (rule assms(1))
show ?thesis
proof(rule is_functorI, unfold cf_cn_comp_components(3,4) cat_op_simps)
show "vfsequence (π β©Cβ©Fβ π)"
unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
show "vcard (π β©Cβ©Fβ π) = 4β©β"
unfolding cf_cn_comp_def by (simp add: nat_omega_simps)
from assms(1) L.cf_is_semifunctor R.cf_is_semifunctor show
"cf_smcf (π β©Cβ©Fβ π) : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
unfolding cf_smcf_cf_cn_comp[symmetric]
by
(
cs_concl cs_intro:
cat_cs_intros slicing_intros smc_cn_cs_intros
)
fix c assume "c ββ©β πβ¦Objβ¦"
with assms show
"(π β©Cβ©Fβ π)β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦(π β©Cβ©Fβ π)β¦ObjMapβ¦β¦cβ¦β¦"
by
(
cs_concl
cs_simp: cat_op_simps cat_cn_cs_simps cs_intro: cat_cs_intros
)
qed (auto simp: cat_cs_simps cat_cs_intros cat_op_simps)
qed
textβΉSee section 1.2 in \cite{bodo_categories_1970}).βΊ
lemma cf_cn_cov_comp_is_functor[cat_cn_cs_intros]:
assumes "π : π
β©Cβ¦β¦βΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "π β©Cβ©Fβ π : π β©Cβ¦β¦βΞ±β β"
proof-
interpret L: is_functor Ξ± βΉop_cat π
βΊ β π by (rule assms(1))
interpret R: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
proof
(
rule is_functorI,
unfold cf_cn_comp_components(3,4) cat_op_simps slicing_commute[symmetric]
)
show "vfsequence (π β©Cβ©Fβ π)" unfolding cf_cn_comp_def by simp
show "vcard (π β©Cβ©Fβ π) = 4β©β"
unfolding cf_cn_comp_def by (auto simp: nat_omega_simps)
from L.cf_is_semifunctor show
"cf_smcf π β©Sβ©Mβ©Cβ©Fβ cf_smcf π : op_smc (cat_smc π) β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
by (cs_concl cs_intro: cat_cs_intros slicing_intros smc_cs_intros)
fix c assume "c ββ©β πβ¦Objβ¦"
with assms show "(π β©Cβ©Fβ π)β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦(π β©Cβ©Fβ π)β¦ObjMapβ¦β¦cβ¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_cn_cs_simps
cs_intro: cat_cs_intros
)
qed (auto simp: cat_cs_simps cat_cs_intros)
qed
textβΉSee section 1.2 in \cite{bodo_categories_1970}.βΊ
lemma cf_cov_cn_comp_is_functor[cat_cn_cs_intros]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β©Cβ¦β¦βΞ±β π
"
shows "π ββ©Cβ©F π : π β©Cβ¦β¦βΞ±β β"
using assms by (rule cf_comp_is_functorI)
textβΉThe opposite of the contravariant composition of functors.βΊ
lemma op_cf_cf_cn_comp[cat_op_simps]: "op_cf (π β©Cβ©Fβ π) = op_cf π β©Cβ©Fβ op_cf π"
unfolding op_cf_def cf_cn_comp_def dghm_field_simps
by (auto simp: nat_omega_simps)
subsectionβΉIdentity functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.βΊ
abbreviation (input) cf_id :: "V β V" where "cf_id β‘ dghm_id"
textβΉSlicing.βΊ
lemma cf_smcf_cf_id[slicing_commute]: "smcf_id (cat_smc β) = cf_smcf (cf_id β)"
unfolding dghm_id_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
by (simp add: nat_omega_simps)
context category
begin
interpretation smc: semicategory Ξ± βΉcat_smc ββΊ by (rule cat_semicategory)
lemmas_with [unfolded slicing_simps]:
cat_smcf_id_is_semifunctor = smc.smc_smcf_id_is_semifunctor
end
subsubsectionβΉObject mapβΊ
lemmas [cat_cs_simps] = dghm_id_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemmas [cat_cs_simps] = dghm_id_ArrMap_app
subsubsectionβΉOpposite of an identity functor.βΊ
lemma op_cf_cf_id[cat_op_simps]: "op_cf (cf_id β) = cf_id (op_cat β)"
unfolding dghm_id_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
by (auto simp: nat_omega_simps)
subsubsectionβΉAn identity functor is a functorβΊ
lemma (in category) cat_cf_id_is_functor: "cf_id β : β β¦β¦β©CβΞ±β β"
proof(rule is_functorI, unfold dghm_id_components)
from cat_smcf_id_is_semifunctor show
"cf_smcf (cf_id β) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
by (simp add: slicing_commute)
from cat_CId_is_arr show
"c ββ©β ββ¦Objβ¦ βΉ vid_on (ββ¦Arrβ¦)β¦ββ¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦vid_on (ββ¦Objβ¦)β¦cβ¦β¦"
for c
by auto
qed (auto simp: dghm_id_def nat_omega_simps cat_cs_intros)
lemma (in category) cat_cf_id_is_functor':
assumes "π = β" and "π
= β"
shows "cf_id β : π β¦β¦β©CβΞ±β π
"
unfolding assms by (rule cat_cf_id_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_id_is_functor'
subsubsectionβΉFurther propertiesβΊ
lemma (in is_functor) cf_cf_comp_cf_id_left[cat_cs_simps]: "cf_id π
ββ©Cβ©F π = π"
by
(
rule cf_eqI,
unfold dghm_id_components dghm_comp_components dghm_id_components
)
(auto intro: cat_cs_intros simp: cf_ArrMap_vrange cf_ObjMap_vrange)
lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_left
lemma (in is_functor) cf_cf_comp_cf_id_right[cat_cs_simps]: "π ββ©Cβ©F cf_id π = π"
by
(
rule cf_eqI,
unfold dghm_id_components dghm_comp_components dghm_id_components
)
(
auto
intro: cat_cs_intros
simp: cat_cs_simps cf_ArrMap_vrange cf_ObjMap_vrange
)
lemmas [cat_cs_simps] = is_functor.cf_cf_comp_cf_id_right
subsectionβΉConstant functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-3 in \cite{mac_lane_categories_2010}.βΊ
abbreviation cf_const :: "V β V β V β V"
where "cf_const β π a β‘ smcf_const β π a (πβ¦CIdβ¦β¦aβ¦)"
textβΉSlicing.βΊ
lemma cf_smcf_cf_const[slicing_commute]:
"smcf_const (cat_smc β) (cat_smc π) a (πβ¦CIdβ¦β¦aβ¦) = cf_smcf (cf_const β π a)"
unfolding
dghm_const_def cat_smc_def cf_smcf_def dghm_field_simps dg_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉObject map and arrow mapβΊ
context
fixes π a :: V
begin
lemmas_with [where π=π and a=a and f=βΉπβ¦CIdβ¦β¦aβ¦βΊ, cat_cs_simps]:
dghm_const_ObjMap_app
dghm_const_ArrMap_app
end
subsubsectionβΉOpposite constant functorβΊ
lemma op_cf_cf_const[cat_op_simps]:
"op_cf (cf_const β π a) = cf_const (op_cat β) (op_cat π) a"
unfolding dghm_const_def op_cat_def op_cf_def dghm_field_simps dg_field_simps
by (auto simp: nat_omega_simps)
subsubsectionβΉA constant functor is a functorβΊ
lemma cf_const_is_functor:
assumes "category Ξ± β" and "category Ξ± π" and "a ββ©β πβ¦Objβ¦"
shows "cf_const β π a : β β¦β¦β©CβΞ±β π"
proof-
interpret β: category Ξ± β by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
show ?thesis
proof(intro is_functorI, tacticβΉdistinct_subgoals_tacβΊ)
show "vfsequence (dghm_const β π a (πβ¦CIdβ¦β¦aβ¦))"
unfolding dghm_const_def by simp
show "vcard (cf_const β π a) = 4β©β"
unfolding dghm_const_def by (simp add: nat_omega_simps)
from assms show "cf_smcf (cf_const β π a) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π"
by
(
cs_concl
cs_simp: cat_cs_simps slicing_simps slicing_commute[symmetric]
cs_intro: smc_cs_intros cat_cs_intros slicing_intros
)
fix c assume "c ββ©β ββ¦Objβ¦"
with assms show
"cf_const β π aβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ = πβ¦CIdβ¦β¦cf_const β π aβ¦ObjMapβ¦β¦cβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: dghm_const_components assms)
qed
lemma cf_const_is_functor'[cat_cs_intros]:
assumes "category Ξ± β"
and "category Ξ± π"
and "a ββ©β πβ¦Objβ¦"
and "π = β"
and "π
= π"
shows "cf_const β π a : π β¦β¦β©CβΞ±β π
"
using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_functor)
subsectionβΉFaithful functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).βΊ
locale is_ft_functor = is_functor Ξ± π π
π for Ξ± π π
π +
assumes ft_cf_is_ft_semifunctor[slicing_intros]:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β cat_smc π
"
syntax "_is_ft_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
" β "CONST is_ft_functor Ξ± π π
π"
lemma (in is_ft_functor) ft_cf_is_ft_functor':
assumes "π' = cat_smc π" and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
'"
unfolding assms by (rule ft_cf_is_ft_semifunctor)
lemmas [slicing_intros] = is_ft_functor.ft_cf_is_ft_functor'
textβΉRules.βΊ
lemma (in is_ft_functor) is_ft_functor_axioms'[cf_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±'β π
'"
unfolding assms by (rule is_ft_functor_axioms)
mk_ide rf is_ft_functor_def[unfolded is_ft_functor_axioms_def]
|intro is_ft_functorI|
|dest is_ft_functorD[dest]|
|elim is_ft_functorE[elim]|
lemmas [cf_cs_intros] = is_ft_functorD(1)
lemma is_ft_functorI':
assumes "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ v11 (πβ¦ArrMapβ¦ βΎβ§lβ©β Hom π a b)"
shows "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
"
using assms
by (intro is_ft_functorI)
(
simp_all add:
assms(1)
is_ft_semifunctorI'[OF is_functorD(6)[
OF assms(1)], unfolded slicing_simps
]
)
lemma is_ft_functorD':
assumes "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ v11 (πβ¦ArrMapβ¦ βΎβ§lβ©β Hom π a b)"
by
(
simp_all add:
is_ft_functorD[OF assms(1)]
is_ft_semifunctorD'(2)[
OF is_ft_functorD(2)[OF assms(1)], unfolded slicing_simps
]
)
lemma is_ft_functorE':
assumes "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ v11 (πβ¦ArrMapβ¦ βΎβ§lβ©β Hom π a b)"
using assms by (simp_all add: is_ft_functorD')
textβΉElementary properties.βΊ
context is_ft_functor
begin
interpretation smcf: is_ft_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule ft_cf_is_ft_semifunctor)
lemmas_with [unfolded slicing_simps]:
ft_cf_v11_on_Hom = smcf.ft_smcf_v11_on_Hom
end
subsubsectionβΉOpposite faithful functor.βΊ
lemma (in is_ft_functor) is_ft_functor_op':
"op_cf π : op_cat π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β op_cat π
"
by (rule is_ft_functorI, unfold slicing_commute[symmetric])
(
simp_all add:
is_functor_op is_ft_semifunctor.is_ft_semifunctor_op
ft_cf_is_ft_semifunctor
)
lemma (in is_ft_functor) is_ft_functor_op:
assumes "π' = op_cat π" and "π
' = op_cat π
"
shows "op_cf π : op_cat π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β op_cat π
"
unfolding assms by (rule is_ft_functor_op')
lemmas is_ft_functor_op[cat_op_intros] = is_ft_functor.is_ft_functor_op'
subsubsectionβΉThe composition of faithful functors is a faithful functorβΊ
lemma cf_comp_is_ft_functor[cf_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β β" and "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β β"
proof(intro is_ft_functorI)
interpret π: is_ft_functor Ξ± π
β π by (simp add: assms(1))
interpret π: is_ft_functor Ξ± π π
π by (simp add: assms(2))
from π.is_functor_axioms π.is_functor_axioms show "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
then interpret is_functor Ξ± π β βΉπ ββ©Cβ©F πβΊ .
show "cf_smcf (π ββ©Cβ©F π) : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β cat_smc β"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
)
qed
subsectionβΉFull functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).βΊ
locale is_fl_functor = is_functor Ξ± π π
π for Ξ± π π
π +
assumes fl_cf_is_fl_semifunctor:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©uβ©lβ©lβΞ±β cat_smc π
"
syntax "_is_fl_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©fβ©uβ©lβ©lΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
" β "CONST is_fl_functor Ξ± π π
π"
lemma (in is_fl_functor) fl_cf_is_fl_functor'[slicing_intros]:
assumes "π' = cat_smc π" and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
'"
unfolding assms by (rule fl_cf_is_fl_semifunctor)
lemmas [slicing_intros] = is_fl_functor.fl_cf_is_fl_semifunctor
textβΉRules.βΊ
lemma (in is_fl_functor) is_fl_functor_axioms'[cf_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±'β π
'"
unfolding assms by (rule is_fl_functor_axioms)
mk_ide rf is_fl_functor_def[unfolded is_fl_functor_axioms_def]
|intro is_fl_functorI|
|dest is_fl_functorD[dest]|
|elim is_fl_functorE[elim]|
lemmas [cf_cs_intros] = is_fl_functorD(1)
lemma is_fl_functorI':
assumes "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ
πβ¦ArrMapβ¦ `β©β (Hom π a b) = Hom π
(πβ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦)"
shows "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
"
using assms
by (intro is_fl_functorI)
(
simp_all add:
assms(1)
is_fl_semifunctorI'[
OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
]
)
lemma is_fl_functorD':
assumes "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ
πβ¦ArrMapβ¦ `β©β (Hom π a b) = Hom π
(πβ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦)"
by
(
simp_all add:
is_fl_functorD[OF assms(1)]
is_fl_semifunctorD'(2)[
OF is_fl_functorD(2)[OF assms(1)], unfolded slicing_simps
]
)
lemma is_fl_functorE':
assumes "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β πβ¦Objβ¦ β§ βΉ
πβ¦ArrMapβ¦ `β©β (Hom π a b) = Hom π
(πβ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦)"
using assms by (simp_all add: is_fl_functorD')
textβΉElementary properties.βΊ
context is_fl_functor
begin
interpretation smcf: is_fl_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule fl_cf_is_fl_semifunctor)
lemmas_with [unfolded slicing_simps]:
fl_cf_surj_on_Hom = smcf.fl_smcf_surj_on_Hom
end
subsubsectionβΉOpposite full functorβΊ
lemma (in is_fl_functor) is_fl_functor_op[cat_op_intros]:
"op_cf π : op_cat π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β op_cat π
"
by (rule is_fl_functorI, unfold slicing_commute[symmetric])
(simp_all add: cat_op_intros smc_op_intros slicing_intros)
lemmas is_fl_functor_op[cat_op_intros] = is_fl_functor.is_fl_functor_op
subsubsectionβΉThe composition of full functor is a full functorβΊ
lemma cf_comp_is_fl_functor[cf_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β β" and "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β β"
proof(intro is_fl_functorI)
interpret π: is_fl_functor Ξ± π π
π using assms(2) by simp
interpret π: is_fl_functor Ξ± π
β π using assms(1) by simp
from π.is_functor_axioms π.is_functor_axioms show "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "cf_smcf (π ββ©Cβ©F π) : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©uβ©lβ©lβΞ±β cat_smc β"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cf_cs_intros smcf_cs_intros slicing_intros
)
qed
subsectionβΉFully faithful functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).βΊ
locale is_ff_functor = is_ft_functor Ξ± π π
π + is_fl_functor Ξ± π π
π
for Ξ± π π
π
syntax "_is_ff_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©fβ©fΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©fβ©fβΞ±β π
" β "CONST is_ff_functor Ξ± π π
π"
textβΉRules.βΊ
mk_ide rf is_ff_functor_def
|intro is_ff_functorI|
|dest is_ff_functorD[dest]|
|elim is_ff_functorE[elim]|
lemmas [cf_cs_intros] = is_ff_functorD
textβΉElementary properties.βΊ
lemma (in is_ff_functor) ff_cf_is_ff_semifunctor:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©fβΞ±β cat_smc π
"
by (rule is_ff_semifunctorI) (auto intro: slicing_intros)
lemma (in is_ff_functor) ff_cf_is_ff_semifunctor'[slicing_intros]:
assumes "π' = cat_smc π" and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©fβΞ±β π
'"
unfolding assms by (rule ff_cf_is_ff_semifunctor)
lemmas [slicing_intros] = is_ff_functor.ff_cf_is_ff_semifunctor'
subsubsectionβΉOpposite fully faithful functorβΊ
lemma (in is_ff_functor) is_ff_functor_op:
"op_cf π : op_cat π β¦β¦β©Cβ©.β©fβ©fβΞ±β op_cat π
"
by (rule is_ff_functorI) (auto simp: is_fl_functor_op is_ft_functor_op)
lemma (in is_ff_functor) is_ff_functor_op'[cat_op_intros]:
assumes "π' = op_cat π" and "π
' = op_cat π
"
shows "op_cf π : π' β¦β¦β©Cβ©.β©fβ©fβΞ±β π
'"
unfolding assms by (rule is_ff_functor_op)
lemmas is_ff_functor_op[cat_op_intros] = is_ff_functor.is_ff_functor_op
subsubsectionβΉ
The composition of fully faithful functors is a fully faithful functor
βΊ
lemma cf_comp_is_ff_functor[cf_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©fβ©fβΞ±β β" and "π : π β¦β¦β©Cβ©.β©fβ©fβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©fβ©fβΞ±β β"
using assms
by (intro is_ff_functorI, elim is_ff_functorE) (auto simp: cf_cs_intros)
subsectionβΉIsomorphism of categoriesβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).βΊ
locale is_iso_functor = is_functor Ξ± π π
π for Ξ± π π
π +
assumes iso_cf_is_iso_semifunctor:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β cat_smc π
"
syntax "_is_iso_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©iβ©sβ©oΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
" β "CONST is_iso_functor Ξ± π π
π"
lemma (in is_iso_functor) iso_cf_is_iso_semifunctor'[slicing_intros]:
assumes "π' = cat_smc π" "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
'"
unfolding assms by (rule iso_cf_is_iso_semifunctor)
lemmas [slicing_intros] = is_iso_semifunctor.iso_smcf_is_iso_dghm'
textβΉRules.βΊ
lemma (in is_iso_functor) is_iso_functor_axioms'[cf_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±'β π
'"
unfolding assms by (rule is_iso_functor_axioms)
mk_ide rf is_iso_functor_def[unfolded is_iso_functor_axioms_def]
|intro is_iso_functorI|
|dest is_iso_functorD[dest]|
|elim is_iso_functorE[elim]|
lemma is_iso_functorI':
assumes "π : π β¦β¦β©CβΞ±β π
"
and "v11 (πβ¦ObjMapβ¦)"
and "v11 (πβ¦ArrMapβ¦)"
and "ββ©β (πβ¦ObjMapβ¦) = π
β¦Objβ¦"
and "ββ©β (πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
shows "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
using assms
by (intro is_iso_functorI)
(
simp_all add:
assms(1)
is_iso_semifunctorI'[
OF is_functorD(6)[OF assms(1)], unfolded slicing_simps
]
)
lemma is_iso_functorD':
assumes "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
and "v11 (πβ¦ObjMapβ¦)"
and "v11 (πβ¦ArrMapβ¦)"
and "ββ©β (πβ¦ObjMapβ¦) = π
β¦Objβ¦"
and "ββ©β (πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
by
(
simp_all add:
is_iso_functorD[OF assms(1)]
is_iso_semifunctorD'(2-5)[
OF is_iso_functorD(2)[OF assms(1)], unfolded slicing_simps
]
)
lemma is_iso_functorE':
assumes "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
and "v11 (πβ¦ObjMapβ¦)"
and "v11 (πβ¦ArrMapβ¦)"
and "ββ©β (πβ¦ObjMapβ¦) = π
β¦Objβ¦"
and "ββ©β (πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
using assms by (simp_all add: is_iso_functorD')
textβΉElementary properties.βΊ
context is_iso_functor
begin
interpretation smcf: is_iso_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule iso_cf_is_iso_semifunctor)
lemmas_with [unfolded slicing_simps]:
iso_cf_ObjMap_vrange[simp] = smcf.iso_smcf_ObjMap_vrange
and iso_cf_ArrMap_vrange[simp] = smcf.iso_smcf_ArrMap_vrange
sublocale ObjMap: v11 βΉπβ¦ObjMapβ¦βΊ
rewrites "πβ©β (πβ¦ObjMapβ¦) = πβ¦Objβ¦" and "ββ©β (πβ¦ObjMapβ¦) = π
β¦Objβ¦"
by (rule smcf.ObjMap.v11_axioms[unfolded slicing_simps])
(simp_all add: cat_cs_simps cf_cs_simps)
sublocale ArrMap: v11 βΉπβ¦ArrMapβ¦βΊ
rewrites "πβ©β (πβ¦ArrMapβ¦) = πβ¦Arrβ¦" and "ββ©β (πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
by (rule smcf.ArrMap.v11_axioms[unfolded slicing_simps])
(simp_all add: cat_cs_simps smcf_cs_simps)
lemmas_with [unfolded slicing_simps]:
iso_cf_Obj_HomDom_if_Obj_HomCod[elim] =
smcf.iso_smcf_Obj_HomDom_if_Obj_HomCod
and iso_cf_Arr_HomDom_if_Arr_HomCod[elim] =
smcf.iso_smcf_Arr_HomDom_if_Arr_HomCod
and iso_cf_ObjMap_eqE[elim] = smcf.iso_smcf_ObjMap_eqE
and iso_cf_ArrMap_eqE[elim] = smcf.iso_smcf_ArrMap_eqE
end
sublocale is_iso_functor β is_ff_functor
proof(intro is_ff_functorI)
interpret is_iso_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule iso_cf_is_iso_semifunctor)
show "π : π β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π
" by unfold_locales
show "π : π β¦β¦β©Cβ©.β©fβ©uβ©lβ©lβΞ±β π
" by unfold_locales
qed
lemmas (in is_iso_functor) iso_cf_is_ff_functor = is_ff_functor_axioms
lemmas [cf_cs_intros] = is_iso_functor.iso_cf_is_ff_functor
subsubsectionβΉOpposite isomorphism of categoriesβΊ
lemma (in is_iso_functor) is_iso_functor_op:
"op_cf π : op_cat π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β op_cat π
"
by (rule is_iso_functorI, unfold slicing_simps slicing_commute[symmetric])
(simp_all add: cat_op_intros smc_op_intros slicing_intros)
lemma (in is_iso_functor) is_iso_functor_op':
assumes "π' = op_cat π" and "π
' = op_cat π
"
shows "op_cf π : op_cat π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β op_cat π
"
unfolding assms by (rule is_iso_functor_op)
lemmas is_iso_functor_op[cat_op_intros] =
is_iso_functor.is_iso_functor_op'
subsubsectionβΉ
The composition of isomorphisms of categories is an isomorphism of categories
βΊ
lemma cf_comp_is_iso_functor[cf_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β" and "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β"
proof(intro is_iso_functorI)
interpret π: is_iso_functor Ξ± π π
π using assms by auto
interpret π: is_iso_functor Ξ± π
β π using assms by auto
from π.is_functor_axioms π.is_functor_axioms show "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "cf_smcf (π ββ©Cβ©F π) : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β cat_smc β"
unfolding slicing_commute[symmetric]
by (cs_concl cs_intro: smcf_cs_intros slicing_intros)
qed
subsectionβΉInverse functorβΊ
abbreviation (input) inv_cf :: "V β V"
where "inv_cf β‘ inv_dghm"
textβΉSlicing.βΊ
lemma dghm_inv_semifunctor[slicing_commute]:
"inv_smcf (cf_smcf π) = cf_smcf (inv_cf π)"
unfolding cf_smcf_def inv_dghm_def dghm_field_simps
by (simp_all add: nat_omega_simps)
context is_iso_functor
begin
interpretation smcf: is_iso_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule iso_cf_is_iso_semifunctor)
lemmas_with [unfolded slicing_simps slicing_commute]:
inv_cf_ObjMap_v11 = smcf.inv_smcf_ObjMap_v11
and inv_cf_ObjMap_vdomain = smcf.inv_smcf_ObjMap_vdomain
and inv_cf_ObjMap_app = smcf.inv_smcf_ObjMap_app
and inv_cf_ObjMap_vrange = smcf.inv_smcf_ObjMap_vrange
and inv_cf_ArrMap_v11 = smcf.inv_smcf_ArrMap_v11
and inv_cf_ArrMap_vdomain = smcf.inv_smcf_ArrMap_vdomain
and inv_cf_ArrMap_app = smcf.inv_smcf_ArrMap_app
and inv_cf_ArrMap_vrange = smcf.inv_smcf_ArrMap_vrange
and iso_cf_ObjMap_inv_cf_ObjMap_app =
smcf.iso_smcf_ObjMap_inv_smcf_ObjMap_app
and iso_cf_ArrMap_inv_cf_ArrMap_app =
smcf.iso_smcf_ArrMap_inv_smcf_ArrMap_app
and iso_cf_HomDom_is_arr_conv = smcf.iso_smcf_HomDom_is_arr_conv
and iso_cf_HomCod_is_arr_conv = smcf.iso_smcf_HomCod_is_arr_conv
end
subsectionβΉAn isomorphism of categories is an isomorphism in the category βΉCATβΊβΊ
lemma is_arr_isomorphism_is_iso_functor:
assumes "π : π β¦β¦β©CβΞ±β π
"
and "π : π
β¦β¦β©CβΞ±β π"
and "π ββ©Cβ©F π = cf_id π"
and "π ββ©Cβ©F π = cf_id π
"
shows "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
proof-
interpret π: is_functor Ξ± π π
π by (rule assms(1))
interpret π: is_functor Ξ± π
π π by (rule assms(2))
show ?thesis
proof(rule is_iso_functorI)
have πππ: "cf_smcf π ββ©Sβ©Mβ©Cβ©F cf_smcf π = smcf_id (cat_smc π)"
by (simp add: assms(3) cf_smcf_cf_id cf_smcf_smcf_comp)
have πππ
: "cf_smcf π ββ©Sβ©Mβ©Cβ©F cf_smcf π = smcf_id (cat_smc π
)"
by (simp add: assms(4) cf_smcf_cf_id cf_smcf_smcf_comp)
from π.cf_is_semifunctor π.cf_is_semifunctor πππ πππ
show
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β cat_smc π
"
by (rule is_arr_isomorphism_is_iso_semifunctor)
qed (auto simp: cat_cs_intros)
qed
lemma is_iso_functor_is_arr_isomorphism:
assumes "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows [cf_cs_intros]: "inv_cf π : π
β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π"
and "inv_cf π ββ©Cβ©F π = cf_id π"
and "π ββ©Cβ©F inv_cf π = cf_id π
"
proof-
let ?π = "inv_cf π"
interpret is_iso_functor Ξ± π π
π by (rule assms(1))
show π: "?π : π
β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π"
proof(intro is_iso_functorI is_functorI, unfold inv_dghm_components)
show "vfsequence ?π" by (simp add: inv_dghm_def)
show "vcard ?π = 4β©β"
unfolding inv_dghm_def by (simp add: nat_omega_simps)
show "cf_smcf ?π : cat_smc π
β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π"
by
(
metis
dghm_inv_semifunctor
iso_cf_is_iso_semifunctor
is_iso_semifunctor_def
is_iso_semifunctor_is_arr_isomorphism(1)
)
show "cf_smcf ?π : cat_smc π
β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β cat_smc π"
by
(
metis
dghm_inv_semifunctor
iso_cf_is_iso_semifunctor
is_iso_semifunctor_is_arr_isomorphism(1)
)
fix c assume prems: "c ββ©β π
β¦Objβ¦"
from prems show "(πβ¦ArrMapβ¦)Β―β©ββ¦π
β¦CIdβ¦β¦cβ¦β¦ = πβ¦CIdβ¦β¦(πβ¦ObjMapβ¦)Β―β©ββ¦cβ¦β¦"
by (intro v11.v11_vconverse_app)
(
cs_concl
cs_intro: cat_cs_intros V_cs_intros
cs_simp: V_cs_simps cat_cs_simps
)+
qed (simp_all add: cat_cs_simps cat_cs_intros)
show "?π ββ©Cβ©F π = cf_id π"
proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
from π is_functor_axioms show "?π ββ©Cβ©F π : π β¦β¦β©CβΞ±β π"
by (blast intro: cat_cs_intros)
qed
(
simp_all add:
HomDom.cat_cf_id_is_functor
ObjMap.v11_vcomp_vconverse
ArrMap.v11_vcomp_vconverse
dghm_id_components
)
show "π ββ©Cβ©F ?π = cf_id π
"
proof(rule cf_eqI, unfold dghm_comp_components inv_dghm_components)
from π is_functor_axioms show "π ββ©Cβ©F ?π : π
β¦β¦β©CβΞ±β π
"
by (blast intro: cat_cs_intros)
show "cf_id π
: π
β¦β¦β©CβΞ±β π
" by (simp add: HomCod.cat_cf_id_is_functor)
qed
(
simp_all add:
ObjMap.v11_vcomp_vconverse'
ArrMap.v11_vcomp_vconverse'
dghm_id_components
)
qed
subsubsectionβΉAn identity functor is an isomorphism of categoriesβΊ
lemma (in category) cat_cf_id_is_iso_functor: "cf_id β : β β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β"
by (rule is_iso_functorI, unfold slicing_commute[symmetric])
(
simp_all add:
cat_cf_id_is_functor
semicategory.smc_smcf_id_is_iso_semifunctor
cat_semicategory
)
subsectionβΉIsomorphic categoriesβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}).βΊ
locale iso_category = L: category Ξ± π + R: category Ξ± π
for Ξ± π π
+
assumes iso_cat_is_iso_functor: "βπ. π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
notation iso_category (infixl "ββ©CΔ±" 50)
textβΉRules.βΊ
lemma iso_categoryI:
assumes "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows "π ββ©CβΞ±β π
"
using assms unfolding iso_category_def iso_category_axioms_def by auto
lemma iso_categoryD[dest]:
assumes "π ββ©CβΞ±β π
"
shows "βπ. π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
using assms unfolding iso_category_def iso_category_axioms_def by simp_all
lemma iso_categoryE[elim]:
assumes "π ββ©CβΞ±β π
"
obtains π where "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
using assms by auto
textβΉIsomorphic categories are isomorphic semicategories.βΊ
lemma (in iso_category) iso_cat_iso_semicategory:
"cat_smc π ββ©Sβ©Mβ©CβΞ±β cat_smc π
"
using iso_cat_is_iso_functor
by (auto intro: slicing_intros iso_semicategoryI)
subsubsectionβΉA category isomorphism is an equivalence relationβΊ
lemma iso_category_refl:
assumes "category Ξ± π"
shows "π ββ©CβΞ±β π"
proof(rule iso_categoryI[of _ _ _ βΉcf_id πβΊ])
interpret category Ξ± π by (rule assms)
show "cf_id π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π" by (simp add: cat_cf_id_is_iso_functor)
qed
lemma iso_category_sym[sym]:
assumes "π ββ©CβΞ±β π
"
shows "π
ββ©CβΞ±β π"
proof-
interpret iso_category Ξ± π π
by (rule assms)
from iso_cat_is_iso_functor obtain π where "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
" by clarsimp
from is_iso_functor_is_arr_isomorphism(1)[OF this] show ?thesis
by (auto intro: iso_categoryI)
qed
lemma iso_category_trans[trans]:
assumes "π ββ©CβΞ±β π
" and "π
ββ©CβΞ±β β"
shows "π ββ©CβΞ±β β"
proof-
interpret L: iso_category Ξ± π π
by (rule assms(1))
interpret R: iso_category Ξ± π
β by (rule assms(2))
from L.iso_cat_is_iso_functor R.iso_cat_is_iso_functor show ?thesis
by (auto intro: iso_categoryI is_iso_functorI cf_comp_is_iso_functor)
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Small_Functor
sectionβΉSmallness for functorsβΊ
theory CZH_ECAT_Small_Functor
imports
CZH_Foundations.CZH_SMC_Small_Semifunctor
CZH_ECAT_Functor
CZH_ECAT_Small_Category
begin
subsectionβΉFunctor with tiny mapsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_tm_functor = is_functor Ξ± π π
π for Ξ± π π
π +
assumes tm_cf_is_semifunctor[slicing_intros]:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π
"
syntax "_is_tm_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©tβ©mΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
" β "CONST is_tm_functor Ξ± π π
π"
abbreviation (input) is_cn_tm_functor :: "V β V β V β V β bool"
where "is_cn_tm_functor Ξ± π π
π β‘ π : op_dg π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
syntax "_is_cn_tm_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β©Cβ©.β©tβ©mβ¦β¦Δ± _)βΊ [51, 51, 51] 51)
translations "π : π β©Cβ©.β©tβ©mβ¦β¦βΞ±β π
" β "CONST is_cn_tm_functor Ξ± π π
π"
abbreviation all_tm_cfs :: "V β V"
where "all_tm_cfs Ξ± β‘ set {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
abbreviation small_tm_cfs :: "V β V β V β V"
where "small_tm_cfs Ξ± π π
β‘ set {π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
lemma (in is_tm_functor) tm_cf_is_semifunctor':
assumes "Ξ±' = Ξ±"
and "π' = cat_smc π"
and "π
' = cat_smc π
"
shows "cf_smcf π : π' β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±'β π
'"
unfolding assms by (rule tm_cf_is_semifunctor)
lemmas [slicing_intros] = is_tm_functor.tm_cf_is_semifunctor'
textβΉRules.βΊ
lemma (in is_tm_functor) is_tm_functor_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©Cβ©.β©tβ©mβΞ±'β π
'"
unfolding assms by (rule is_tm_functor_axioms)
mk_ide rf is_tm_functor_def[unfolded is_tm_functor_axioms_def]
|intro is_tm_functorI|
|dest is_tm_functorD[dest]|
|elim is_tm_functorE[elim]|
lemmas [cat_small_cs_intros] = is_tm_functorD(1)
textβΉSlicing.βΊ
context is_tm_functor
begin
interpretation smcf: is_tm_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule tm_cf_is_semifunctor)
lemmas_with [unfolded slicing_simps]:
tm_cf_ObjMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ObjMap_in_Vset
and tm_cf_ArrMap_in_Vset[cat_cs_intros] = smcf.tm_smcf_ArrMap_in_Vset
end
sublocale is_tm_functor β HomDom: tiny_category Ξ± π
proof(rule tiny_categoryI')
show "πβ¦Objβ¦ ββ©β Vset Ξ±"
by (rule vdomain_in_VsetI[OF tm_cf_ObjMap_in_Vset, unfolded cat_cs_simps])
show "πβ¦Arrβ¦ ββ©β Vset Ξ±"
by (rule vdomain_in_VsetI[OF tm_cf_ArrMap_in_Vset, unfolded cat_cs_simps])
qed (simp add: cat_cs_intros)
textβΉFurther rules.βΊ
lemma is_tm_functorI':
assumes [simp]: "π : π β¦β¦β©CβΞ±β π
"
and [simp]: "πβ¦ObjMapβ¦ ββ©β Vset Ξ±"
and [simp]: "πβ¦ArrMapβ¦ ββ©β Vset Ξ±"
shows "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof(intro is_tm_functorI)
interpret is_functor Ξ± π π
π by (rule assms(1))
show "cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π
"
by (intro is_tm_semifunctorI', unfold slicing_simps)
(auto simp: slicing_intros)
qed simp_all
lemma is_tm_functorD':
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦ObjMapβ¦ ββ©β Vset Ξ±"
and "πβ¦ArrMapβ¦ ββ©β Vset Ξ±"
proof-
interpret is_tm_functor Ξ± π π
π by (rule assms(1))
show "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦ObjMapβ¦ ββ©β Vset Ξ±"
and "πβ¦ArrMapβ¦ ββ©β Vset Ξ±"
by (auto intro: cat_cs_intros)
qed
lemmas [cat_small_cs_intros] = is_tm_functorD'(1)
lemma is_tm_functorE':
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦ObjMapβ¦ ββ©β Vset Ξ±"
and "πβ¦ArrMapβ¦ ββ©β Vset Ξ±"
using is_tm_functorD'[OF assms] by simp
textβΉSize.βΊ
lemma small_all_tm_cfs[simp]: "small {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
proof(rule down)
show
"{π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
} β
elts (set {π. βπ π
. π : π β¦β¦β©CβΞ±β π
})"
proof
(
simp only: elts_of_set small_all_cfs if_True,
rule subsetI,
unfold mem_Collect_eq
)
fix π assume "βπ π
. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
then obtain π π
where "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
" by clarsimp
then interpret is_tm_functor Ξ± π π
π .
show "βπ π
. π : π β¦β¦β©CβΞ±β π
" by (blast intro: is_functor_axioms')
qed
qed
subsubsectionβΉOpposite functor with tiny mapsβΊ
lemma (in is_tm_functor) is_tm_functor_op:
"op_cf π : op_cat π β¦β¦β©Cβ©.β©tβ©mβΞ±β op_cat π
"
by (intro is_tm_functorI', unfold cat_op_simps)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_tm_functor) is_tm_functor_op'[cat_op_intros]:
assumes "π' = op_cat π" and "π
' = op_cat π
" and "Ξ±' = Ξ±"
shows "op_cf π : π' β¦β¦β©Cβ©.β©tβ©mβΞ±'β π
'"
unfolding assms by (rule is_tm_functor_op)
lemmas is_tm_functor_op[cat_op_intros] = is_tm_functor.is_tm_functor_op'
subsubsectionβΉComposition of functors with tiny mapsβΊ
lemma cf_comp_is_tm_functor[cat_small_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof(rule is_tm_functorI)
interpret π: is_tm_functor Ξ± π π
π by (rule assms(2))
interpret π: is_tm_functor Ξ± π
β π by (rule assms(1))
from π.tm_cf_is_semifunctor π.tm_cf_is_semifunctor show
"cf_smcf (π ββ©Cβ©F π) : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc β"
by (auto simp: smc_small_cs_intros slicing_commute[symmetric])
show "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β" by (auto intro: cat_cs_intros)
qed
subsubsectionβΉFinite categories and functors with tiny mapsβΊ
lemma (in is_functor) cf_is_tm_functor_if_HomDom_finite_category:
assumes "finite_category Ξ± π"
shows "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof(intro is_tm_functorI)
interpret π: finite_category Ξ± π by (rule assms(1))
show "cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π
"
by
(
rule
is_semifunctor.smcf_is_tm_semifunctor_if_HomDom_finite_semicategory[
OF cf_is_semifunctor π.fin_cat_finite_semicategory
]
)
qed (auto intro: cat_cs_intros)
subsubsectionβΉConstant functor with tiny mapsβΊ
lemma cf_const_is_tm_functor:
assumes "tiny_category Ξ± β" and "category Ξ± π" and "a ββ©β πβ¦Objβ¦"
shows "cf_const β π a : β β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
proof(intro is_tm_functorI)
from assms show "cf_smcf (cf_const β π a) : cat_smc β β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π"
by
(
cs_concl
cs_simp: slicing_commute[symmetric] slicing_simps cat_cs_simps
cs_intro: slicing_intros cat_cs_intros smc_small_cs_intros
)+
from assms show "cf_const β π a : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
qed
lemma cf_const_is_tm_functor'[cat_small_cs_intros]:
assumes "tiny_category Ξ± β"
and "category Ξ± π"
and "a ββ©β πβ¦Objβ¦"
and "β' = β"
and "π' = π"
shows "cf_const β π a : β' β¦β¦β©Cβ©.β©tβ©mβΞ±β π'"
using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tm_functor)
subsectionβΉTiny functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_tiny_functor = is_functor Ξ± π π
π for Ξ± π π
π +
assumes tiny_cf_is_tiny_semifunctor[slicing_intros]:
"cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ±β cat_smc π
"
syntax "_is_tiny_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β¦β¦β©Cβ©.β©tβ©iβ©nβ©yΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" β "CONST is_tiny_functor Ξ± π π
π"
abbreviation (input) is_cn_tiny_cf :: "V β V β V β V β bool"
where "is_cn_tiny_cf Ξ± π π
π β‘ π : op_cat π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
syntax "_is_cn_tiny_cf" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β©Cβ©.β©tβ©iβ©nβ©yβ¦β¦Δ± _)βΊ [51, 51, 51] 51)
translations "π : π β©Cβ©.β©tβ©iβ©nβ©yβ¦β¦βΞ±β π
" β "CONST is_cn_cf Ξ± π π
π"
abbreviation all_tiny_cfs :: "V β V"
where "all_tiny_cfs Ξ± β‘ set {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
abbreviation tiny_cfs :: "V β V β V β V"
where "tiny_cfs Ξ± π π
β‘ set {π. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
lemmas [slicing_intros] = is_tiny_functor.tiny_cf_is_tiny_semifunctor
textβΉRules.βΊ
lemma (in is_tiny_functor) is_tiny_functor_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±'β π
'"
unfolding assms by (rule is_tiny_functor_axioms)
mk_ide rf is_tiny_functor_def[unfolded is_tiny_functor_axioms_def]
|intro is_tiny_functorI|
|dest is_tiny_functorD[dest]|
|elim is_tiny_functorE[elim]|
lemmas [cat_small_cs_intros] = is_tiny_functorD(1)
textβΉElementary properties.βΊ
sublocale is_tiny_functor β HomDom: tiny_category Ξ± π
proof(intro tiny_categoryI')
interpret smcf: is_tiny_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule tiny_cf_is_tiny_semifunctor)
show "πβ¦Objβ¦ ββ©β Vset Ξ±"
by (rule smcf.HomDom.tiny_smc_Obj_in_Vset[unfolded slicing_simps])
show "πβ¦Arrβ¦ ββ©β Vset Ξ±"
by (rule smcf.HomDom.tiny_smc_Arr_in_Vset[unfolded slicing_simps])
qed (auto simp: cat_cs_intros)
sublocale is_tiny_functor β HomCod: tiny_category Ξ± π
proof(intro tiny_categoryI')
interpret smcf: is_tiny_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule tiny_cf_is_tiny_semifunctor)
show "π
β¦Objβ¦ ββ©β Vset Ξ±"
by (rule smcf.HomCod.tiny_smc_Obj_in_Vset[unfolded slicing_simps])
show "π
β¦Arrβ¦ ββ©β Vset Ξ±"
by (rule smcf.HomCod.tiny_smc_Arr_in_Vset[unfolded slicing_simps])
qed (auto simp: cat_cs_intros)
sublocale is_tiny_functor β is_tm_functor
proof(intro is_tm_functorI')
interpret smcf: is_tiny_semifunctor Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ
by (rule tiny_cf_is_tiny_semifunctor)
note Vset[unfolded slicing_simps] =
smcf.tm_smcf_ObjMap_in_Vset
smcf.tm_smcf_ArrMap_in_Vset
show "πβ¦ObjMapβ¦ ββ©β Vset Ξ±" "πβ¦ArrMapβ¦ ββ©β Vset Ξ±" by (intro Vset)+
qed (auto simp: cat_cs_intros)
textβΉFurther rules.βΊ
lemma is_tiny_functorI':
assumes [simp]: "π : π β¦β¦β©CβΞ±β π
"
and "tiny_category Ξ± π"
and "tiny_category Ξ± π
"
shows "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof(intro is_tiny_functorI)
interpret π: is_functor Ξ± π π
π by (rule assms(1))
interpret π: tiny_category Ξ± π by (rule assms(2))
interpret π
: tiny_category Ξ± π
by (rule assms(3))
show "cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ±β cat_smc π
"
by (intro is_tiny_semifunctorI') (auto intro: slicing_intros)
qed (rule assms(1))
lemma is_tiny_functorD':
assumes "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
and "tiny_category Ξ± π"
and "tiny_category Ξ± π
"
proof-
interpret is_tiny_functor Ξ± π π
π by (rule assms(1))
show "π : π β¦β¦β©CβΞ±β π
" and "tiny_category Ξ± π" and "tiny_category Ξ± π
"
by (auto intro: cat_small_cs_intros)
qed
lemmas [cat_small_cs_intros] = is_tiny_functorD'(2,3)
lemma is_tiny_functorE':
assumes "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
and "tiny_category Ξ± π"
and "tiny_category Ξ± π
"
using is_tiny_functorD'[OF assms] by auto
lemma is_tiny_functor_iff:
"π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
β·
(π : π β¦β¦β©CβΞ±β π
β§ tiny_category Ξ± π β§ tiny_category Ξ± π
)"
by (auto intro: is_tiny_functorI' dest: is_tiny_functorD'(2,3))
textβΉSize.βΊ
lemma (in is_tiny_functor) tiny_cf_in_Vset: "π ββ©β Vset Ξ±"
proof-
note [cat_cs_intros] =
tm_cf_ObjMap_in_Vset
tm_cf_ArrMap_in_Vset
HomDom.tiny_cat_in_Vset
HomCod.tiny_cat_in_Vset
show ?thesis
by (subst cf_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed
lemma small_all_tiny_cfs[simp]: "small {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
proof(rule down)
show
"{π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
} β
elts (set {π. βπ π
. π : π β¦β¦β©CβΞ±β π
})"
proof
(
simp only: elts_of_set small_all_cfs if_True,
rule subsetI,
unfold mem_Collect_eq
)
fix π assume "βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
then obtain π π
where "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" by clarsimp
then interpret is_tiny_functor Ξ± π π
π by simp
show "βπ π
. π : π β¦β¦β©CβΞ±β π
" by (meson is_functor_axioms)
qed
qed
lemma small_tiny_cfs[simp]: "small {π. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}βΊ]) auto
lemma all_tiny_cfs_vsubset_Vset[simp]:
"set {π. βπ π
. π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
} ββ©β Vset Ξ±"
proof(rule vsubsetI)
fix π assume "π ββ©β all_tiny_cfs Ξ±"
then obtain π π
where "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" by clarsimp
then show "π ββ©β Vset Ξ±" by (auto simp: is_tiny_functor.tiny_cf_in_Vset)
qed
lemma (in is_functor) cf_is_tiny_functor_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
"
proof(intro is_tiny_functorI)
show "cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_smc π
"
by
(
rule is_semifunctor.smcf_is_tiny_semifunctor_if_ge_Limit,
rule cf_is_semifunctor;
intro assms
)
qed (simp add: cf_is_functor_if_ge_Limit assms)
subsubsectionβΉOpposite tiny semifunctorβΊ
lemma (in is_tiny_functor) is_tiny_functor_op:
"op_cf π : op_cat π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β op_cat π
"
by (intro is_tiny_functorI')
(cs_concl cs_intro: cat_op_intros cat_small_cs_intros)+
lemma (in is_tiny_functor) is_tiny_functor_op'[cat_op_intros]:
assumes "π' = op_cat π" and "π
' = op_cat π
" and "Ξ±' = Ξ±"
shows "op_cf π : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±'β π
'"
unfolding assms by (rule is_tiny_functor_op)
lemmas is_tiny_functor_op[cat_op_intros] =
is_tiny_functor.is_tiny_functor_op'
subsubsectionβΉComposition of tiny functorsβΊ
lemma cf_comp_is_tiny_functor[cat_small_cs_intros]:
assumes "π : π
β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β β" and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π ββ©Cβ©F π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β β"
proof-
interpret π: is_tiny_functor Ξ± π π
π by (rule assms(2))
interpret π: is_tiny_functor Ξ± π
β π by (rule assms(1))
show ?thesis by (rule is_tiny_functorI') (auto intro: cat_small_cs_intros)
qed
subsubsectionβΉTiny constant functorβΊ
lemma cf_const_is_tiny_functor:
assumes "tiny_category Ξ± β" and "tiny_category Ξ± π" and "a ββ©β πβ¦Objβ¦"
shows "cf_const β π a : β β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π"
proof(intro is_tiny_functorI')
from assms show "cf_const β π a : β β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_small_cs_intros)
qed (auto simp: assms(1,2))
lemma cf_const_is_tiny_functor':
assumes "tiny_category Ξ± β"
and "tiny_category Ξ± π"
and "a ββ©β πβ¦Objβ¦"
and "β' = β"
and "π' = π"
shows "cf_const β π a : β' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π'"
using assms(1-3) unfolding assms(4,5) by (rule cf_const_is_tiny_functor)
lemmas [cat_small_cs_intros] = cf_const_is_tiny_functor'
textβΉ\newpageβΊ
end
Theory CZH_ECAT_NTCF
sectionβΉNatural transformationβΊ
theory CZH_ECAT_NTCF
imports
CZH_Foundations.CZH_SMC_NTSMCF
CZH_ECAT_Functor
begin
subsectionβΉBackgroundβΊ
named_theorems ntcf_cs_simps
named_theorems ntcf_cs_intros
lemmas [cat_cs_simps] = dg_shared_cs_simps
lemmas [cat_cs_intros] = dg_shared_cs_intros
subsubsectionβΉSlicingβΊ
definition ntcf_ntsmcf :: "V β V"
where "ntcf_ntsmcf π =
[
πβ¦NTMapβ¦,
cf_smcf (πβ¦NTDomβ¦),
cf_smcf (πβ¦NTCodβ¦),
cat_smc (πβ¦NTDGDomβ¦),
cat_smc (πβ¦NTDGCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma ntcf_ntsmcf_components:
shows [slicing_simps]: "ntcf_ntsmcf πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and [slicing_commute]: "ntcf_ntsmcf πβ¦NTDomβ¦ = cf_smcf (πβ¦NTDomβ¦)"
and [slicing_commute]: "ntcf_ntsmcf πβ¦NTCodβ¦ = cf_smcf (πβ¦NTCodβ¦)"
and [slicing_commute]: "ntcf_ntsmcf πβ¦NTDGDomβ¦ = cat_smc (πβ¦NTDGDomβ¦)"
and [slicing_commute]: "ntcf_ntsmcf πβ¦NTDGCodβ¦ = cat_smc (πβ¦NTDGCodβ¦)"
unfolding ntcf_ntsmcf_def nt_field_simps by (auto simp: nat_omega_simps)
subsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The definition of a natural transformation that is used in this work is
is similar to the definition that can be found in Chapter I-4 in
\cite{mac_lane_categories_2010}.
βΊ
locale is_ntcf =
π΅ Ξ± +
vfsequence π +
NTDom: is_functor Ξ± π π
π +
NTCod: is_functor Ξ± π π
π
for Ξ± π π
π π π +
assumes ntcf_length[cat_cs_simps]: "vcard π = 5β©β"
and ntcf_is_ntsmcf[slicing_intros]: "ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©F cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π
"
and ntcf_NTDom[cat_cs_simps]: "πβ¦NTDomβ¦ = π"
and ntcf_NTCod[cat_cs_simps]: "πβ¦NTCodβ¦ = π"
and ntcf_NTDGDom[cat_cs_simps]: "πβ¦NTDGDomβ¦ = π"
and ntcf_NTDGCod[cat_cs_simps]: "πβ¦NTDGCodβ¦ = π
"
syntax "_is_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ β¦β©Cβ©F _ :/ _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" β "CONST is_ntcf Ξ± π π
π π π"
abbreviation all_ntcfs :: "V β V"
where "all_ntcfs Ξ± β‘ set {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
abbreviation ntcfs :: "V β V β V β V"
where "ntcfs Ξ± π π
β‘ set {π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
abbreviation these_ntcfs :: "V β V β V β V β V β V"
where "these_ntcfs Ξ± π π
π π β‘ set {π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
lemmas [cat_cs_simps] =
is_ntcf.ntcf_length
is_ntcf.ntcf_NTDom
is_ntcf.ntcf_NTCod
is_ntcf.ntcf_NTDGDom
is_ntcf.ntcf_NTDGCod
lemma (in is_ntcf) ntcf_is_ntsmcf':
assumes "π' = cf_smcf π"
and "π' = cf_smcf π"
and "π' = cat_smc π"
and "π
' = cat_smc π
"
shows "ntcf_ntsmcf π : π' β¦β©Sβ©Mβ©Cβ©F π' : π' β¦β¦β©Sβ©Mβ©CβΞ±β π
'"
unfolding assms(1-4) by (rule ntcf_is_ntsmcf)
lemmas [slicing_intros] = is_ntcf.ntcf_is_ntsmcf'
textβΉRules.βΊ
lemma (in is_ntcf) is_ntcf_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
" and "π' = π" and "π' = π"
shows "π : π' β¦β©Cβ©F π' : π' β¦β¦β©CβΞ±'β π
'"
unfolding assms by (rule is_ntcf_axioms)
mk_ide rf is_ntcf_def[unfolded is_ntcf_axioms_def]
|intro is_ntcfI|
|dest is_ntcfD[dest]|
|elim is_ntcfE[elim]|
lemmas [cat_cs_intros] =
is_ntcfD(3,4)
lemma is_ntcfI':
assumes "π΅ Ξ±"
and "vfsequence π"
and "vcard π = 5β©β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦NTDomβ¦ = π"
and "πβ¦NTCodβ¦ = π"
and "πβ¦NTDGDomβ¦ = π"
and "πβ¦NTDGCodβ¦ = π
"
and "vsv (πβ¦NTMapβ¦)"
and "πβ©β (πβ¦NTMapβ¦) = πβ¦Objβ¦"
and "βa. a ββ©β πβ¦Objβ¦ βΉ πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦"
shows "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (intro is_ntcfI is_ntsmcfI', unfold ntcf_ntsmcf_components slicing_simps)
(
simp_all add:
assms nat_omega_simps
ntcf_ntsmcf_def
is_functorD(6)[OF assms(4)]
is_functorD(6)[OF assms(5)]
)
lemma is_ntcfD':
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "π΅ Ξ±"
and "vfsequence π"
and "vcard π = 5β©β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦NTDomβ¦ = π"
and "πβ¦NTCodβ¦ = π"
and "πβ¦NTDGDomβ¦ = π"
and "πβ¦NTDGCodβ¦ = π
"
and "vsv (πβ¦NTMapβ¦)"
and "πβ©β (πβ¦NTMapβ¦) = πβ¦Objβ¦"
and "βa. a ββ©β πβ¦Objβ¦ βΉ πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦"
by
(
simp_all add:
is_ntcfD(2-10)[OF assms]
is_ntsmcfD'[OF is_ntcfD(6)[OF assms], unfolded slicing_simps]
)
lemma is_ntcfE':
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
obtains "π΅ Ξ±"
and "vfsequence π"
and "vcard π = 5β©β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©CβΞ±β π
"
and "πβ¦NTDomβ¦ = π"
and "πβ¦NTCodβ¦ = π"
and "πβ¦NTDGDomβ¦ = π"
and "πβ¦NTDGCodβ¦ = π
"
and "vsv (πβ¦NTMapβ¦)"
and "πβ©β (πβ¦NTMapβ¦) = πβ¦Objβ¦"
and "βa. a ββ©β πβ¦Objβ¦ βΉ πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "βa b f. f : a β¦βπβ b βΉ
πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦"
using assms by (simp add: is_ntcfD')
textβΉSlicing.βΊ
context is_ntcf
begin
interpretation ntsmcf:
is_ntsmcf Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ βΉcf_smcf πβΊ βΉntcf_ntsmcf πβΊ
by (rule ntcf_is_ntsmcf)
lemmas_with [unfolded slicing_simps]:
ntcf_NTMap_vsv = ntsmcf.ntsmcf_NTMap_vsv
and ntcf_NTMap_vdomain[cat_cs_simps] = ntsmcf.ntsmcf_NTMap_vdomain
and ntcf_NTMap_is_arr = ntsmcf.ntsmcf_NTMap_is_arr
and ntcf_NTMap_is_arr'[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_is_arr'
sublocale NTMap: vsv βΉπβ¦NTMapβ¦βΊ
rewrites "πβ©β (πβ¦NTMapβ¦) = πβ¦Objβ¦"
by (rule ntcf_NTMap_vsv) (simp add: cat_cs_simps)
lemmas_with [unfolded slicing_simps]:
ntcf_NTMap_app_in_Arr[cat_cs_intros] = ntsmcf.ntsmcf_NTMap_app_in_Arr
and ntcf_NTMap_vrange_vifunion = ntsmcf.ntsmcf_NTMap_vrange_vifunion
and ntcf_NTMap_vrange = ntsmcf.ntsmcf_NTMap_vrange
and ntcf_NTMap_vsubset_Vset = ntsmcf.ntsmcf_NTMap_vsubset_Vset
and ntcf_NTMap_in_Vset = ntsmcf.ntsmcf_NTMap_in_Vset
and ntcf_is_ntsmcf_if_ge_Limit = ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit
lemmas_with [unfolded slicing_simps]:
ntcf_Comp_commute[cat_cs_intros] = ntsmcf.ntsmcf_Comp_commute
and ntcf_Comp_commute' = ntsmcf.ntsmcf_Comp_commute'
and ntcf_Comp_commute'' = ntsmcf.ntsmcf_Comp_commute''
end
lemmas [cat_cs_simps] = is_ntcf.ntcf_NTMap_vdomain
lemmas [cat_cs_intros] =
is_ntcf.ntcf_NTMap_is_arr'
ntsmcf_hcomp_NTMap_vsv
textβΉElementary properties.βΊ
lemma ntcf_eqI:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π' : π' β¦β©Cβ©F π' : π' β¦β¦β©CβΞ±β π
'"
and "πβ¦NTMapβ¦ = π'β¦NTMapβ¦"
and "π = π'"
and "π = π'"
and "π = π'"
and "π
= π
'"
shows "π = π'"
proof-
interpret L: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret R: is_ntcf Ξ± π' π
' π' π' π' by (rule assms(2))
show ?thesis
proof(rule vsv_eqI)
have dom: "πβ©β π = 5β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
show "πβ©β π = πβ©β π'" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
from assms(4-7) have sup:
"πβ¦NTDomβ¦ = π'β¦NTDomβ¦" "πβ¦NTCodβ¦ = π'β¦NTCodβ¦"
"πβ¦NTDGDomβ¦ = π'β¦NTDGDomβ¦" "πβ¦NTDGCodβ¦ = π'β¦NTDGCodβ¦"
by (simp_all add: cat_cs_simps)
show "a ββ©β πβ©β π βΉ πβ¦aβ¦ = π'β¦aβ¦" for a
by (unfold dom, elim_in_numeral, insert assms(3) sup)
(auto simp: nt_field_simps)
qed auto
qed
lemma ntcf_ntsmcf_eqI:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π' : π' β¦β©Cβ©F π' : π' β¦β¦β©CβΞ±β π
'"
and "π = π'"
and "π = π'"
and "π = π'"
and "π
= π
'"
and "ntcf_ntsmcf π = ntcf_ntsmcf π'"
shows "π = π'"
proof(rule ntcf_eqI[of Ξ±])
from assms(7) have "ntcf_ntsmcf πβ¦NTMapβ¦ = ntcf_ntsmcf π'β¦NTMapβ¦" by simp
then show "πβ¦NTMapβ¦ = π'β¦NTMapβ¦" unfolding slicing_simps by simp_all
from assms(3-6) show "π = π'" "π = π'" "π = π'" "π
= π
'" by simp_all
qed (auto simp: assms(1,2))
lemma (in is_ntcf) ntcf_def:
"π = [πβ¦NTMapβ¦, πβ¦NTDomβ¦, πβ¦NTCodβ¦, πβ¦NTDGDomβ¦, πβ¦NTDGCodβ¦]β©β"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β π = 5β©β" by (cs_concl cs_simp: cat_cs_simps V_cs_simps)
have dom_rhs:
"πβ©β [πβ¦NTMapβ¦, πβ¦NTDGDomβ¦, πβ¦NTDGCodβ¦, πβ¦NTDomβ¦, πβ¦NTCodβ¦]β©β = 5β©β"
by (simp add: nat_omega_simps)
then show
"πβ©β π = πβ©β [πβ¦NTMapβ¦, πβ¦NTDomβ¦, πβ¦NTCodβ¦, πβ¦NTDGDomβ¦, πβ¦NTDGCodβ¦]β©β"
unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
show "a ββ©β πβ©β π βΉ
πβ¦aβ¦ = [πβ¦NTMapβ¦, πβ¦NTDomβ¦, πβ¦NTCodβ¦, πβ¦NTDGDomβ¦, πβ¦NTDGCodβ¦]β©ββ¦aβ¦"
for a
by (unfold dom_lhs, elim_in_numeral, unfold nt_field_simps)
(simp_all add: nat_omega_simps)
qed (auto simp: vsv_axioms)
lemma (in is_ntcf) ntcf_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π ββ©β Vset Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
note [cat_cs_intros] =
ntcf_NTMap_in_Vset
NTDom.cf_in_Vset
NTCod.cf_in_Vset
NTDom.HomDom.cat_in_Vset
NTDom.HomCod.cat_in_Vset
from assms(2) show ?thesis
by (subst ntcf_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed
lemma (in is_ntcf) ntcf_is_ntcf_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ²β π
"
proof(intro is_ntcfI)
show "ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©F cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ²β cat_smc π
"
by (rule is_ntsmcf.ntsmcf_is_ntsmcf_if_ge_Limit[OF ntcf_is_ntsmcf assms])
qed
(
cs_concl
cs_simp: cat_cs_simps
cs_intro:
V_cs_intros
assms
NTDom.cf_is_functor_if_ge_Limit
NTCod.cf_is_functor_if_ge_Limit
)+
lemma small_all_ntcfs[simp]:
"small {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
proof(cases βΉπ΅ Ξ±βΊ)
case True
from is_ntcf.ntcf_in_Vset show ?thesis
by (intro down[of _ βΉVset (Ξ± + Ο)βΊ])
(auto simp: True π΅.π΅_Limit_Ξ±Ο π΅.π΅_Ο_Ξ±Ο π΅.intro π΅.π΅_Ξ±_Ξ±Ο)
next
case False
then have "{π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
} = {}" by auto
then show ?thesis by simp
qed
lemma small_ntcfs[simp]: "small {π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}βΊ]) auto
lemma small_these_ntcfs[simp]: "small {π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}βΊ]) auto
textβΉFurther elementary results.βΊ
lemma these_ntcfs_iff:
"π ββ©β these_ntcfs Ξ± π π
π π β· π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
subsectionβΉOpposite natural transformationβΊ
textβΉSee section 1.5 in \cite{bodo_categories_1970}.βΊ
definition op_ntcf :: "V β V"
where "op_ntcf π =
[
πβ¦NTMapβ¦,
op_cf (πβ¦NTCodβ¦),
op_cf (πβ¦NTDomβ¦),
op_cat (πβ¦NTDGDomβ¦),
op_cat (πβ¦NTDGCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma op_ntcf_components[cat_op_simps]:
shows "op_ntcf πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "op_ntcf πβ¦NTDomβ¦ = op_cf (πβ¦NTCodβ¦)"
and "op_ntcf πβ¦NTCodβ¦ = op_cf (πβ¦NTDomβ¦)"
and "op_ntcf πβ¦NTDGDomβ¦ = op_cat (πβ¦NTDGDomβ¦)"
and "op_ntcf πβ¦NTDGCodβ¦ = op_cat (πβ¦NTDGCodβ¦)"
unfolding op_ntcf_def nt_field_simps by (auto simp: nat_omega_simps)
textβΉSlicing.βΊ
lemma ntcf_ntsmcf_op_ntcf[slicing_commute]:
"op_ntsmcf (ntcf_ntsmcf π) = ntcf_ntsmcf (op_ntcf π)"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (op_ntsmcf (ntcf_ntsmcf π)) = 5β©β"
unfolding op_ntsmcf_def by (auto simp: nat_omega_simps)
have dom_rhs: "πβ©β (ntcf_ntsmcf (op_ntcf π)) = 5β©β"
unfolding ntcf_ntsmcf_def by (auto simp: nat_omega_simps)
show "πβ©β (op_ntsmcf (ntcf_ntsmcf π)) = πβ©β (ntcf_ntsmcf (op_ntcf π))"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (op_ntsmcf (ntcf_ntsmcf π)) βΉ
op_ntsmcf (ntcf_ntsmcf π)β¦aβ¦ = ntcf_ntsmcf (op_ntcf π)β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold nt_field_simps ntcf_ntsmcf_def op_ntcf_def op_ntsmcf_def
)
(auto simp: nat_omega_simps slicing_commute[symmetric])
qed (auto simp: ntcf_ntsmcf_def op_ntsmcf_def)
textβΉElementary properties.βΊ
lemma op_ntcf_vsv[cat_op_intros]: "vsv (op_ntcf π)"
unfolding op_ntcf_def by auto
subsubsectionβΉFurther propertiesβΊ
lemma (in is_ntcf) is_ntcf_op:
"op_ntcf π : op_cf π β¦β©Cβ©F op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat π
"
proof(rule is_ntcfI, unfold cat_op_simps)
show "vfsequence (op_ntcf π)" by (simp add: op_ntcf_def)
show "vcard (op_ntcf π) = 5β©β" by (simp add: op_ntcf_def nat_omega_simps)
qed
(
use is_ntcf_axioms in
βΉ
cs_concl
cs_simp: cat_cs_simps slicing_commute[symmetric]
cs_intro: cat_cs_intros cat_op_intros smc_op_intros slicing_intros
βΊ
)+
lemma (in is_ntcf) is_ntcf_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cat π"
and "π
' = op_cat π
"
shows "op_ntcf π : π' β¦β©Cβ©F π' : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule is_ntcf_op)
lemmas [cat_op_intros] = is_ntcf.is_ntcf_op'
lemma (in is_ntcf) ntcf_op_ntcf_op_ntcf[cat_op_simps]:
"op_ntcf (op_ntcf π) = π"
proof(rule ntcf_eqI[of Ξ± π π
π π _ π π
π π], unfold cat_op_simps)
interpret op:
is_ntcf Ξ± βΉop_cat πβΊ βΉop_cat π
βΊ βΉop_cf πβΊ βΉop_cf πβΊ βΉop_ntcf πβΊ
by (rule is_ntcf_op)
from op.is_ntcf_op show
"op_ntcf (op_ntcf π) : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (simp add: cat_op_simps)
qed (auto simp: cat_cs_intros)
lemmas ntcf_op_ntcf_op_ntcf[cat_op_simps] =
is_ntcf.ntcf_op_ntcf_op_ntcf
lemma eq_op_ntcf_iff[cat_op_simps]:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" and "π' : π' β¦β©Cβ©F π' : π' β¦β¦β©CβΞ±β π
'"
shows "op_ntcf π = op_ntcf π' β· π = π'"
proof
interpret L: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret R: is_ntcf Ξ± π' π
' π' π' π' by (rule assms(2))
assume prems: "op_ntcf π = op_ntcf π'"
show "π = π'"
proof(rule ntcf_eqI[OF assms])
from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf show
"πβ¦NTMapβ¦ = π'β¦NTMapβ¦"
by metis+
from prems L.ntcf_op_ntcf_op_ntcf R.ntcf_op_ntcf_op_ntcf
have "πβ¦NTDomβ¦ = π'β¦NTDomβ¦"
and "πβ¦NTCodβ¦ = π'β¦NTCodβ¦"
and "πβ¦NTDGDomβ¦ = π'β¦NTDGDomβ¦"
and "πβ¦NTDGCodβ¦ = π'β¦NTDGCodβ¦"
by metis+
then show "π = π'" "π = π'" "π = π'" "π
= π
'"
by (auto simp: cat_cs_simps)
qed
qed auto
subsectionβΉVertical composition of natural transformationsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-4 in \cite{mac_lane_categories_2010}.βΊ
abbreviation (input) ntcf_vcomp :: "V β V β V" (infixl βΉββ©Nβ©Tβ©Cβ©FβΊ 55)
where "ntcf_vcomp β‘ ntsmcf_vcomp"
lemmas [cat_cs_simps] = ntsmcf_vcomp_components(2-5)
textβΉSlicing.βΊ
lemma ntcf_ntsmcf_ntcf_vcomp[slicing_commute]:
"ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π = ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π)"
unfolding
ntsmcf_vcomp_def ntcf_ntsmcf_def cat_smc_def nt_field_simps dg_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma ntcf_vcomp_NTMap_vdomain[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) = πβ¦Objβ¦"
proof-
interpret π: is_ntcf Ξ± π π
π π π using assms by auto
show ?thesis
by
(
rule ntsmcf_vcomp_NTMap_vdomain
[
OF π.ntcf_is_ntsmcf,
of βΉntcf_ntsmcf πβΊ,
unfolded slicing_commute slicing_simps
]
)
qed
lemma ntcf_vcomp_NTMap_app[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "a ββ©β πβ¦Objβ¦"
shows "(π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦"
proof-
interpret π: is_ntcf Ξ± π π
π β π using assms by clarsimp
interpret π: is_ntcf Ξ± π π
π π π using assms by clarsimp
show ?thesis
by
(
rule ntsmcf_vcomp_NTMap_app
[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_commute slicing_simps,
OF assms(3)
]
)
qed
lemma ntcf_vcomp_NTMap_vrange:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) ββ©β π
β¦Arrβ¦"
proof-
interpret π: is_ntcf Ξ± π π
π β π using assms by auto
interpret π: is_ntcf Ξ± π π
π π π using assms by auto
show ?thesis
by
(
rule
ntsmcf_vcomp_NTMap_vrange[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
)
qed
subsubsectionβΉFurther propertiesβΊ
lemma ntcf_vcomp_composable_commute[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and [intro]: "f : a β¦βπβ b"
shows
"(πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦bβ¦) ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ =
ββ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β (πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦)"
proof-
interpret π: is_ntcf Ξ± π π
π β π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
by
(
rule ntsmcf_vcomp_composable_commute[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps,
OF assms(3)
]
)
qed
lemma ntcf_vcomp_is_ntcf[cat_cs_intros]:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
proof-
interpret π: is_ntcf Ξ± π π
π β π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(intro is_ntcfI)
show "vfsequence (π ββ©Nβ©Tβ©Cβ©F π)" by (simp add: ntsmcf_vcomp_def)
show "vcard (π ββ©Nβ©Tβ©Cβ©F π) = 5β©β"
unfolding ntsmcf_vcomp_def by (simp add: nat_omega_simps)
show "ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π) :
cf_smcf π β¦β©Sβ©Mβ©Cβ©F cf_smcf β : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π
"
by
(
rule ntsmcf_vcomp_is_ntsmcf[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
)
qed (auto simp: ntsmcf_vcomp_components(1) cat_cs_simps cat_cs_intros)
qed
lemma ntcf_vcomp_assoc[cat_cs_simps]:
assumes "π : β β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "(π ββ©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F π = π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π)"
proof-
interpret π: is_ntcf Ξ± π π
β π π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π β π by (rule assms(2))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(3))
show ?thesis
proof(rule ntcf_eqI[of Ξ±])
from ntsmcf_vcomp_assoc[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
have
"ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ =
ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
by simp
then show "(π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ = (π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
unfolding slicing_simps .
qed (auto intro: cat_cs_intros)
qed
subsubsectionβΉ
The opposite of the vertical composition of natural transformations
βΊ
lemma op_ntcf_ntcf_vcomp[cat_op_simps]:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "op_ntcf (π ββ©Nβ©Tβ©Cβ©F π) = op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π"
proof-
interpret π: is_ntcf Ξ± π π
π β π using assms(1) by auto
interpret π: is_ntcf Ξ± π π
π π π using assms(2) by auto
show ?thesis
proof(rule sym, rule ntcf_eqI[of Ξ±])
from
op_ntsmcf_ntsmcf_vcomp
[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
have "ntcf_ntsmcf (op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π)β¦NTMapβ¦ =
ntcf_ntsmcf (op_ntcf (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
by simp
then show "(op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π)β¦NTMapβ¦ = op_ntcf (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦"
unfolding slicing_simps .
qed (auto intro: cat_cs_intros cat_op_intros)
qed
subsectionβΉHorizontal composition of natural transformationsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-5 in \cite{mac_lane_categories_2010}.βΊ
abbreviation (input) ntcf_hcomp :: "V β V β V" (infixl βΉββ©Nβ©Tβ©Cβ©FβΊ 55)
where "ntcf_hcomp β‘ ntsmcf_hcomp"
lemmas [cat_cs_simps] = ntsmcf_hcomp_components(2-5)
textβΉSlicing.βΊ
lemma ntcf_ntsmcf_ntcf_hcomp[slicing_commute]:
"ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π = ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π)"
proof(rule vsv_eqI)
show "vsv (ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π)"
unfolding ntsmcf_hcomp_def by auto
show "vsv (ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π))" unfolding ntcf_ntsmcf_def by auto
have dom_lhs:
"πβ©β (ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π) = 5β©β"
unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π)) = 5β©β"
unfolding ntcf_ntsmcf_def by (simp add: nat_omega_simps)
show "πβ©β (ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π) =
πβ©β (ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π))"
unfolding dom_lhs dom_rhs ..
fix a assume "a ββ©β πβ©β (ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π)"
then show
"(ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π)β¦aβ¦ = ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π)β¦aβ¦"
unfolding dom_lhs
by (elim_in_numeral; fold nt_field_simps)
(simp_all add: ntsmcf_hcomp_components slicing_simps slicing_commute)
qed
subsubsectionβΉNatural transformation mapβΊ
lemma ntcf_hcomp_NTMap_vdomain[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) = πβ¦Objβ¦"
proof-
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(1))
show ?thesis unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
qed
lemma ntcf_hcomp_NTMap_app[cat_cs_simps]:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "a ββ©β πβ¦Objβ¦"
shows "(π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ =
π'β¦ArrMapβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ ββ©Aβββ πβ¦NTMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
proof-
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
from assms(3) show ?thesis
unfolding ntsmcf_hcomp_components by (simp add: cat_cs_simps)
qed
lemma ntcf_hcomp_NTMap_vrange:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
by
(
rule ntsmcf_hcomp_NTMap_vrange[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
)
qed
subsubsectionβΉFurther propertiesβΊ
lemma ntcf_hcomp_composable_commute:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "f : a β¦βπβ b"
shows
"(π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦bβ¦ ββ©Aβββ (π' ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ =
(π' ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦"
(is βΉ?ππb ββ©Aβββ ?π'πf = ?π'πf ββ©Aβββ ?ππaβΊ)
proof-
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
by
(
rule ntsmcf_hcomp_composable_commute[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute,
OF assms(3)
]
)
qed
lemma ntcf_hcomp_is_ntcf:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π' ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
proof-
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(intro is_ntcfI)
show "vfsequence (π ββ©Nβ©Tβ©Cβ©F π)"
unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
show "vcard (π ββ©Nβ©Tβ©Cβ©F π) = 5β©β"
unfolding ntsmcf_hcomp_def by (simp add: nat_omega_simps)
show "ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π) :
cf_smcf (π' ββ©Sβ©Mβ©Cβ©F π) β¦β©Sβ©Mβ©Cβ©F cf_smcf (π' ββ©Cβ©F π) :
cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
by
(
rule ntsmcf_hcomp_is_ntsmcf[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
)
qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps intro: cat_cs_intros)
qed
lemma ntcf_hcomp_is_ntcf'[cat_cs_intros]:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π = π' ββ©Cβ©F π"
and "π' = π' ββ©Cβ©F π"
shows "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_ntcf)
lemma ntcf_hcomp_associativ[cat_cs_simps]:
assumes "π : π'' β¦β©Cβ©F π'' : β β¦β¦β©CβΞ±β π"
and "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "(π ββ©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F π = π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π)"
proof-
interpret π: is_ntcf Ξ± β π π'' π'' π by (rule assms(1))
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(2))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(3))
show ?thesis
proof(rule ntcf_eqI[of Ξ±])
show "π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) :
π'' ββ©Cβ©F π' ββ©Cβ©F π β¦β©Cβ©F π'' ββ©Cβ©F π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from ntsmcf_hcomp_assoc[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_commute
]
have
"ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ =
ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
by simp
then show "(π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ = (π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
unfolding slicing_simps .
qed (auto intro: cat_cs_intros)
qed
subsubsectionβΉ
The opposite of the horizontal composition of natural transformations
βΊ
lemma op_ntcf_ntcf_hcomp[cat_op_simps]:
assumes "π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "op_ntcf (π ββ©Nβ©Tβ©Cβ©F π) = op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π"
proof-
interpret π: is_ntcf Ξ± π
β π' π' π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(rule sym, rule ntcf_eqI[of Ξ±])
from op_ntsmcf_ntsmcf_hcomp[
OF π.ntcf_is_ntsmcf π.ntcf_is_ntsmcf,
unfolded slicing_simps slicing_commute
]
have "ntcf_ntsmcf (op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π)β¦NTMapβ¦ =
ntcf_ntsmcf (op_ntcf (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
by simp
then show "(op_ntcf π ββ©Nβ©Tβ©Cβ©F op_ntcf π)β¦NTMapβ¦ = op_ntcf (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦"
unfolding slicing_simps .
have "π ββ©Nβ©Tβ©Cβ©F π : π' ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (rule ntcf_hcomp_is_ntcf[OF assms])
from is_ntcf.is_ntcf_op[OF this] show
"op_ntcf (π ββ©Nβ©Tβ©Cβ©F π) :
op_cf π' ββ©Cβ©F op_cf π β¦β©Cβ©F op_cf π' ββ©Cβ©F op_cf π :
op_cat π β¦β¦β©CβΞ±β op_cat β"
unfolding cat_op_simps .
qed (auto intro: cat_op_intros cat_cs_intros)
qed
subsectionβΉInterchange lawβΊ
lemma ntcf_comp_interchange_law:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π' : π' β¦β©Cβ©F β' : π
β¦β¦β©CβΞ±β β"
and "π' : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
shows "((π' ββ©Nβ©Tβ©Cβ©F π') ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π)) = (π' ββ©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π' ββ©Nβ©Tβ©Cβ©F π)"
proof-
interpret π: is_ntcf Ξ± π π
π β π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
interpret π': is_ntcf Ξ± π
β π' β' π' by (rule assms(3))
interpret π': is_ntcf Ξ± π
β π' π' π' by (rule assms(4))
show ?thesis
proof(rule ntcf_eqI)
from ntsmcf_comp_interchange_law
[
OF
π.ntcf_is_ntsmcf
π.ntcf_is_ntsmcf
π'.ntcf_is_ntsmcf
π'.ntcf_is_ntsmcf
]
have
"(
(ntcf_ntsmcf π' ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π') ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F
(ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π)
)β¦NTMapβ¦ =
(
(ntcf_ntsmcf π' ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π) ββ©Nβ©Tβ©Cβ©F
(ntcf_ntsmcf π' ββ©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π)
)β¦NTMapβ¦"
by simp
then show
"(π' ββ©Nβ©Tβ©Cβ©F π' ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦ =
(π' ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π' ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
unfolding slicing_simps slicing_commute .
qed (auto intro: cat_cs_intros)
qed
subsectionβΉIdentity natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-4 in \cite{mac_lane_categories_2010}.βΊ
definition ntcf_id :: "V β V"
where "ntcf_id π = [πβ¦HomCodβ¦β¦CIdβ¦ ββ©β πβ¦ObjMapβ¦, π, π, πβ¦HomDomβ¦, πβ¦HomCodβ¦]β©β"
textβΉComponents.βΊ
lemma ntcf_id_components:
shows "ntcf_id πβ¦NTMapβ¦ = πβ¦HomCodβ¦β¦CIdβ¦ ββ©β πβ¦ObjMapβ¦"
and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id πβ¦NTDomβ¦ = π"
and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id πβ¦NTCodβ¦ = π"
and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id πβ¦NTDGDomβ¦ = πβ¦HomDomβ¦"
and [dg_shared_cs_simps, cat_cs_simps]: "ntcf_id πβ¦NTDGCodβ¦ = πβ¦HomCodβ¦"
unfolding ntcf_id_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma (in is_functor) is_functor_ntcf_id_components:
shows "ntcf_id πβ¦NTMapβ¦ = π
β¦CIdβ¦ ββ©β πβ¦ObjMapβ¦"
and "ntcf_id πβ¦NTDomβ¦ = π"
and "ntcf_id πβ¦NTCodβ¦ = π"
and "ntcf_id πβ¦NTDGDomβ¦ = π"
and "ntcf_id πβ¦NTDGCodβ¦ = π
"
unfolding ntcf_id_components by (simp_all add: cat_cs_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma (in is_functor) ntcf_id_NTMap_vdomain[cat_cs_simps]:
"πβ©β (ntcf_id πβ¦NTMapβ¦) = πβ¦Objβ¦"
using cf_ObjMap_vrange unfolding is_functor_ntcf_id_components
by (auto simp: cat_cs_simps)
lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_vdomain
lemma (in is_functor) ntcf_id_NTMap_app_vdomain[cat_cs_simps]:
assumes [simp]: "a ββ©β πβ¦Objβ¦"
shows "ntcf_id πβ¦NTMapβ¦β¦aβ¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
unfolding is_functor_ntcf_id_components
by (rule vsv_vcomp_at) (auto simp: cf_ObjMap_vrange cat_cs_simps cat_cs_intros)
lemmas [cat_cs_simps] = is_functor.ntcf_id_NTMap_app_vdomain
lemma (in is_functor) ntcf_id_NTMap_vsv[cat_cs_intros]:
"vsv (ntcf_id πβ¦NTMapβ¦)"
unfolding is_functor_ntcf_id_components by (auto intro: vsv_vcomp)
lemmas [cat_cs_intros] = is_functor.ntcf_id_NTMap_vsv
lemma (in is_functor) ntcf_id_NTMap_vrange:
"ββ©β (ntcf_id πβ¦NTMapβ¦) ββ©β π
β¦Arrβ¦"
proof(rule vsubsetI)
interpret vsv βΉntcf_id πβ¦NTMapβ¦βΊ by (rule ntcf_id_NTMap_vsv)
fix f assume "f ββ©β ββ©β (ntcf_id πβ¦NTMapβ¦)"
then obtain a
where f_def: "f = ntcf_id πβ¦NTMapβ¦β¦aβ¦" and a: "a ββ©β πβ©β (ntcf_id πβ¦NTMapβ¦)"
using vrange_atD by metis
then have "a ββ©β πβ¦Objβ¦" and "f = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
by (auto simp: cat_cs_simps)
then show "f ββ©β π
β¦Arrβ¦"
by (auto dest: cf_ObjMap_app_in_HomCod_Obj HomCod.cat_CId_is_arr)
qed
subsubsectionβΉFurther propertiesβΊ
lemma (in is_functor) cf_ntcf_id_is_ntcf[cat_cs_intros]:
"ntcf_id π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
proof(rule is_ntcfI, unfold is_functor_ntcf_id_components(2,3,4,5))
show "ntcf_ntsmcf (ntcf_id π) :
cf_smcf π β¦β©Sβ©Mβ©Cβ©F cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π
"
proof
(
rule is_ntsmcfI,
unfold slicing_simps slicing_commute is_functor_ntcf_id_components(2,3,4,5)
)
show "ntsmcf_tdghm (ntcf_ntsmcf (ntcf_id π)) :
smcf_dghm (cf_smcf π) β¦β©Dβ©Gβ©Hβ©M smcf_dghm (cf_smcf π) :
smc_dg (cat_smc π) β¦β¦β©Dβ©GβΞ±β smc_dg (cat_smc π
)"
by
(
rule is_tdghmI,
unfold
slicing_simps
slicing_commute
is_functor_ntcf_id_components(2,3,4,5)
)
(
auto
simp:
cat_cs_simps
cat_cs_intros
nat_omega_simps
ntsmcf_tdghm_def
cf_is_semifunctor
intro: slicing_intros
)
fix f a b assume "f : a β¦βπβ b"
with is_functor_axioms show "ntcf_id πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β ntcf_id πβ¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: ntcf_ntsmcf_def nat_omega_simps intro: slicing_intros)
qed (auto simp: ntcf_id_def nat_omega_simps intro: cat_cs_intros)
lemma (in is_functor) cf_ntcf_id_is_ntcf':
assumes "π' = π" and "β' = π"
shows "ntcf_id π : π' β¦β©Cβ©F β' : π β¦β¦β©CβΞ±β π
"
unfolding assms by (rule cf_ntcf_id_is_ntcf)
lemmas [cat_cs_intros] = is_functor.cf_ntcf_id_is_ntcf'
lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_left_left[cat_cs_simps]:
"ntcf_id π ββ©Nβ©Tβ©Cβ©F π = π"
proof(rule ntcf_eqI[of Ξ±])
interpret id: is_ntcf Ξ± π π
π π βΉntcf_id πβΊ
by (rule NTCod.cf_ntcf_id_is_ntcf)
show "(ntcf_id π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ = πβ¦NTMapβ¦"
proof(rule vsv_eqI)
show [simp]: "πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) = πβ©β (πβ¦NTMapβ¦)"
unfolding ntsmcf_vcomp_components
by (simp add: cat_cs_simps)
fix a assume "a ββ©β πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦)"
then have "a ββ©β πβ¦Objβ¦" by (simp add: cat_cs_simps)
then show "(ntcf_id π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: ntsmcf_vcomp_components)
qed (auto intro: cat_cs_intros)
lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_left_left
lemma (in is_ntcf) ntcf_ntcf_vcomp_ntcf_id_right_left[cat_cs_simps]:
"π ββ©Nβ©Tβ©Cβ©F ntcf_id π = π"
proof(rule ntcf_eqI[of Ξ±])
interpret id: is_ntcf Ξ± π π
π π βΉntcf_id πβΊ
by (rule NTDom.cf_ntcf_id_is_ntcf)
show "(π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦ = πβ¦NTMapβ¦"
proof(rule vsv_eqI)
show [simp]: "πβ©β ((π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦) = πβ©β (πβ¦NTMapβ¦)"
unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
fix a assume "a ββ©β πβ©β ((π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦)"
then have "a ββ©β πβ¦Objβ¦" by (simp add: cat_cs_simps)
then show "(π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: ntsmcf_vcomp_components)
qed (auto intro: cat_cs_intros)
lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_vcomp_ntcf_id_right_left
lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_left_left[cat_cs_simps]:
"ntcf_id (cf_id π
) ββ©Nβ©Tβ©Cβ©F π = π"
proof(rule ntcf_eqI)
interpret id: is_ntcf Ξ± π
π
βΉcf_id π
βΊ βΉcf_id π
βΊ βΉntcf_id (cf_id π
)βΊ
by
(
simp add:
NTDom.HomCod.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
)
show "ntcf_id (cf_id π
) ββ©Nβ©Tβ©Cβ©F π :
cf_id π
ββ©Cβ©F π β¦β©Cβ©F cf_id π
ββ©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
show "(ntcf_id (cf_id π
) ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ = πβ¦NTMapβ¦"
proof(rule vsv_eqI)
fix a assume "a ββ©β πβ©β ((ntcf_id (cf_id π
) ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦)"
then have a: "a ββ©β πβ¦Objβ¦"
unfolding ntcf_hcomp_NTMap_vdomain[OF is_ntcf_axioms] by simp
with is_ntcf_axioms show
"(ntcf_id (cf_id π
) ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
qed (auto simp: cat_cs_simps intro: cat_cs_intros)
lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_left_left
lemma (in is_ntcf) ntcf_ntcf_hcomp_ntcf_id_right_left[cat_cs_simps]:
"π ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id π) = π"
proof(rule ntcf_eqI[of Ξ±])
interpret id: is_ntcf Ξ± π π βΉcf_id πβΊ βΉcf_id πβΊ βΉntcf_id (cf_id π)βΊ
by
(
simp add:
NTDom.HomDom.cat_cf_id_is_functor is_functor.cf_ntcf_id_is_ntcf
)
show "π ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id π) :
π ββ©Cβ©F cf_id π β¦β©Cβ©F π ββ©Cβ©F cf_id π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
show "(π ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id π))β¦NTMapβ¦ = πβ¦NTMapβ¦"
proof(rule vsv_eqI)
fix a assume "a ββ©β πβ©β ((π ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id π))β¦NTMapβ¦)"
then have a: "a ββ©β πβ¦Objβ¦"
unfolding ntcf_hcomp_NTMap_vdomain[OF id.is_ntcf_axioms] by simp
with is_ntcf_axioms show
"(π ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id π))β¦NTMapβ¦β¦aβ¦ = πβ¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: ntsmcf_hcomp_components(1) cat_cs_simps)
qed (auto simp: cat_cs_simps cat_cs_intros)
lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_hcomp_ntcf_id_right_left
subsubsectionβΉThe opposite identity natural transformationβΊ
lemma (in is_functor) cf_ntcf_id_op_cf: "ntcf_id (op_cf π) = op_ntcf (ntcf_id π)"
proof(rule ntcf_eqI)
show ntcfid_op:
"ntcf_id (op_cf π) : op_cf π β¦β©Cβ©F op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat π
"
by (simp add: is_functor.cf_ntcf_id_is_ntcf local.is_functor_op)
show "ntcf_id (op_cf π)β¦NTMapβ¦ = op_ntcf (ntcf_id π)β¦NTMapβ¦"
by (rule vsv_eqI, unfold cat_op_simps)
(
auto
simp: cat_op_simps cat_cs_simps ntcf_id_components(1)
intro: vsv_vcomp
)
qed (auto intro: cat_op_intros cat_cs_intros)
subsubsectionβΉIdentity natural transformation of a composition of functorsβΊ
lemma ntcf_id_cf_comp:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_id (π ββ©Cβ©F π) = ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π"
proof(rule ntcf_eqI)
from assms show ππ: "ntcf_id (π ββ©Cβ©F π) : π ββ©Cβ©F π β¦β©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
interpret ππ: is_ntcf Ξ± π β βΉπ ββ©Cβ©F πβΊ βΉπ ββ©Cβ©F πβΊ βΉntcf_id (π ββ©Cβ©F π)βΊ
by (rule ππ)
from assms show π_π:
"ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π : π ββ©Cβ©F π β¦β©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
interpret π_π: is_ntcf Ξ± π β βΉπ ββ©Cβ©F πβΊ βΉπ ββ©Cβ©F πβΊ βΉntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id πβΊ
by (rule π_π)
show "ntcf_id (π ββ©Cβ©F π)β¦NTMapβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold ππ.ntcf_NTMap_vdomain π_π.ntcf_NTMap_vdomain)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms show
"ntcf_id (π ββ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed auto
qed auto
lemmas [cat_cs_simps] = ntcf_id_cf_comp[symmetric]
subsectionβΉComposition of a natural transformation and a functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
abbreviation (input) ntcf_cf_comp :: "V β V β V" (infixl "ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F" 55)
where "ntcf_cf_comp β‘ tdghm_dghm_comp"
textβΉSlicing.βΊ
lemma ntsmcf_tdghm_ntsmcf_smcf_comp[slicing_commute]:
"ntcf_ntsmcf π ββ©Nβ©Tβ©Sβ©Mβ©Cβ©Fβ©-β©Sβ©Mβ©Cβ©F cf_smcf β = ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)"
unfolding
ntcf_ntsmcf_def
cf_smcf_def
cat_smc_def
tdghm_dghm_comp_def
dghm_comp_def
ntsmcf_tdghm_def
smcf_dghm_def
smc_dg_def
dg_field_simps
dghm_field_simps
nt_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda (in is_functor)
tdghm_dghm_comp_components(1)[where β=π, unfolded cf_HomDom]
|vdomain ntcf_cf_comp_NTMap_vdomain[cat_cs_simps]|
|app ntcf_cf_comp_NTMap_app[cat_cs_simps]|
lemmas [cat_cs_simps] =
is_functor.ntcf_cf_comp_NTMap_vdomain
is_functor.ntcf_cf_comp_NTMap_app
lemma ntcf_cf_comp_NTMap_vrange:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β" and "β : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_functor Ξ± π π
β by (rule assms(2))
show ?thesis unfolding tdghm_dghm_comp_components
by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed
subsubsectionβΉ
Opposite of the composition of a natural transformation and a functor
βΊ
lemma op_ntcf_ntcf_cf_comp[cat_op_simps]:
"op_ntcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) = op_ntcf π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf β"
unfolding
tdghm_dghm_comp_def
dghm_comp_def
op_ntcf_def
op_cf_def
op_cat_def
dg_field_simps
dghm_field_simps
nt_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉ
Composition of a natural transformation and a
functor is a natural transformation
βΊ
lemma ntcf_cf_comp_is_ntcf:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β" and "β : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β : π ββ©Cβ©F β β¦β©Cβ©F π ββ©Cβ©F β : π β¦β¦β©CβΞ±β β"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_functor Ξ± π π
β by (rule assms(2))
show ?thesis
proof(rule is_ntcfI)
show "vfsequence (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)"
unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
from assms show "π ββ©Cβ©F β : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "π ββ©Cβ©F β : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "vcard (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) = 5β©β"
unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
from assms show
"ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) :
cf_smcf (π ββ©Cβ©F β) β¦β©Sβ©Mβ©Cβ©F cf_smcf (π ββ©Cβ©F β) :
cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: slicing_intros smc_cs_intros cat_cs_intros
)
qed (auto simp: tdghm_dghm_comp_components(1) cat_cs_simps)
qed
lemma ntcf_cf_comp_is_functor'[cat_cs_intros]:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "β : π β¦β¦β©CβΞ±β π
"
and "π' = π ββ©Cβ©F β"
and "π' = π ββ©Cβ©F β"
shows "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (simp add: ntcf_cf_comp_is_ntcf)
subsubsectionβΉFurther propertiesβΊ
lemma ntcf_cf_comp_ntcf_cf_comp_assoc:
assumes "π : β β¦β©Cβ©F β' : β β¦β¦β©CβΞ±β π"
and "π : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β¦β©CβΞ±β π
"
shows "(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π = π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (π ββ©Cβ©F π)"
proof-
interpret π: is_ntcf Ξ± β π β β' π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_functor Ξ± π π
π by (rule assms(3))
show ?thesis
proof(rule ntcf_ntsmcf_eqI)
from assms show
"(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π :
β ββ©Cβ©F π ββ©Cβ©F π β¦β©Cβ©F β' ββ©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros)
show "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (π ββ©Cβ©F π) :
β ββ©Cβ©F π ββ©Cβ©F π β¦β©Cβ©F β' ββ©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms show
"ntcf_ntsmcf ((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) =
ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F (π ββ©Cβ©F π))"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: slicing_intros ntsmcf_smcf_comp_ntsmcf_smcf_comp_assoc
)
qed simp_all
qed
lemma (in is_ntcf) ntcf_ntcf_cf_comp_cf_id[cat_cs_simps]:
"π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_id π = π"
proof(rule ntcf_ntsmcf_eqI)
show "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_id π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
show "ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_id π) = ntcf_ntsmcf π"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cat_cs_intros slicing_intros smc_cs_simps
)
qed simp_all
lemmas [cat_cs_simps] = is_ntcf.ntcf_ntcf_cf_comp_cf_id
lemma ntcf_vcomp_ntcf_cf_comp[cat_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F β : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows "(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) = (π ββ©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π"
proof(rule ntcf_ntsmcf_eqI)
from assms show
"π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) :
π ββ©Cβ©F π β¦β©Cβ©F β ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show
"ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)) =
ntcf_ntsmcf (π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
unfolding slicing_commute[symmetric]
by (intro ntsmcf_vcomp_ntsmcf_smcf_comp)
(cs_concl cs_intro: slicing_intros)
qed (use assms in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
subsectionβΉComposition of a functor and a natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
abbreviation (input) cf_ntcf_comp :: "V β V β V" (infixl "ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F" 55)
where "cf_ntcf_comp β‘ dghm_tdghm_comp"
textβΉSlicing.βΊ
lemma ntcf_ntsmcf_cf_ntcf_comp[slicing_commute]:
"cf_smcf β ββ©Sβ©Mβ©Cβ©Fβ©-β©Nβ©Tβ©Sβ©Mβ©Cβ©F ntcf_ntsmcf π = ntcf_ntsmcf (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)"
unfolding
ntcf_ntsmcf_def
cf_smcf_def
cat_smc_def
dghm_tdghm_comp_def
dghm_comp_def
ntsmcf_tdghm_def
smcf_dghm_def
smc_dg_def
dg_field_simps
dghm_field_simps
nt_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda (in is_ntcf)
dghm_tdghm_comp_components(1)[where π=π, unfolded ntcf_NTDGDom]
|vdomain cf_ntcf_comp_NTMap_vdomain|
|app cf_ntcf_comp_NTMap_app|
lemmas [cat_cs_simps] =
is_ntcf.cf_ntcf_comp_NTMap_vdomain
is_ntcf.cf_ntcf_comp_NTMap_app
lemma cf_ntcf_comp_NTMap_vrange:
assumes "β : π
β¦β¦β©CβΞ±β β" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "ββ©β ((β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret β: is_functor Ξ± π
β β by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
unfolding dghm_tdghm_comp_components
by (auto simp: cat_cs_simps intro: cat_cs_intros)
qed
subsubsectionβΉ
Opposite of the composition of a functor and a natural transformation
βΊ
lemma op_ntcf_cf_ntcf_comp[cat_op_simps]:
"op_ntcf (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) = op_cf β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F op_ntcf π"
unfolding
dghm_tdghm_comp_def
dghm_comp_def
op_ntcf_def
op_cf_def
op_cat_def
dg_field_simps
dghm_field_simps
nt_field_simps
by (simp add: nat_omega_simps)
subsubsectionβΉ
Composition of a functor and a natural transformation
is a natural transformation
βΊ
lemma cf_ntcf_comp_is_ntcf:
assumes "β : π
β¦β¦β©CβΞ±β β" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π : β ββ©Cβ©F π β¦β©Cβ©F β ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
proof-
interpret β: is_functor Ξ± π
β β by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(rule is_ntcfI)
show "vfsequence (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)" unfolding dghm_tdghm_comp_def by simp
from assms show "β ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "β ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "vcard (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) = 5β©β"
unfolding dghm_tdghm_comp_def by (simp add: nat_omega_simps)
from assms show "ntcf_ntsmcf (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) :
cf_smcf (β ββ©Cβ©F π) β¦β©Sβ©Mβ©Cβ©F cf_smcf (β ββ©Cβ©F π) :
cat_smc π β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: slicing_intros smc_cs_intros
)
qed (auto simp: dghm_tdghm_comp_components(1) cat_cs_simps)
qed
lemma cf_ntcf_comp_is_functor'[cat_cs_intros]:
assumes "β : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π' = β ββ©Cβ©F π"
and "π' = β ββ©Cβ©F π"
shows "β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (simp add: cf_ntcf_comp_is_ntcf)
subsubsectionβΉFurther propertiesβΊ
lemma cf_comp_cf_ntcf_comp_assoc:
assumes "π : β β¦β©Cβ©F β' : π β¦β¦β©CβΞ±β π
"
and "π : π
β¦β¦β©CβΞ±β β"
and "π : β β¦β¦β©CβΞ±β π"
shows "(π ββ©Cβ©F π) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π = π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)"
proof(rule ntcf_ntsmcf_eqI)
interpret π: is_ntcf Ξ± π π
β β' π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_functor Ξ± β π π by (rule assms(3))
from assms show "(π ββ©Cβ©F π) ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π :
π ββ©Cβ©F π ββ©Cβ©F β β¦β©Cβ©F π ββ©Cβ©F π ββ©Cβ©F β' : π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) :
π ββ©Cβ©F π ββ©Cβ©F β β¦β©Cβ©F π ββ©Cβ©F π ββ©Cβ©F β' : π β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms show
"ntcf_ntsmcf (π ββ©Cβ©F π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) =
ntcf_ntsmcf (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π))"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: slicing_intros smcf_comp_smcf_ntsmcf_comp_assoc
)
qed simp_all
lemma (in is_ntcf) ntcf_cf_ntcf_comp_cf_id[cat_cs_simps]:
"cf_id π
ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π = π"
proof(rule ntcf_ntsmcf_eqI)
show "cf_id π
ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
show "ntcf_ntsmcf (smcf_id π
ββ©Sβ©Mβ©Cβ©Fβ©-β©Nβ©Tβ©Sβ©Mβ©Cβ©F π) = ntcf_ntsmcf π"
by
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cat_cs_intros slicing_intros smc_cs_simps
)
qed simp_all
lemmas [cat_cs_simps] = is_ntcf.ntcf_cf_ntcf_comp_cf_id
lemma cf_ntcf_comp_ntcf_cf_comp_assoc:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "β : β β¦β¦β©CβΞ±β π"
and "π : π β¦β¦β©CβΞ±β π
"
shows "(β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π = β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_functor Ξ± β π β by (rule assms(2))
interpret π: is_functor Ξ± π π
π by (rule assms(3))
show ?thesis
by (rule ntcf_ntsmcf_eqI)
(
use assms in
βΉ
cs_concl
cs_simp: cat_cs_simps slicing_commute[symmetric]
cs_intro:
cat_cs_intros
slicing_intros
smcf_ntsmcf_comp_ntsmcf_smcf_comp_assoc
βΊ
)+
qed
lemma ntcf_cf_comp_ntcf_id[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π = ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π"
proof(rule ntcf_eqI)
from assms have dom_lhs: "πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms have dom_rhs: "πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)β¦NTMapβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms show
"(ntcf_id π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros)
qed (use assms in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
lemma cf_comp_cf_const_right[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π
β¦β¦β©CβΞ±β β"
and "π ββ©β π
β¦Objβ¦"
shows "π ββ©Cβ©F cf_const π π
π = cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)"
proof(rule cf_eqI)
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_functor Ξ± π
β π by (rule assms(3))
from assms(4) show "π ββ©Cβ©F cf_const π π
π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms(4) show "cf_const π β (πβ¦ObjMapβ¦β¦πβ¦) : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(4) have ObjMap_dom_lhs:
"πβ©β ((π ββ©Cβ©F cf_const π π
π)β¦ObjMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(4) have ObjMap_dom_rhs:
"πβ©β (cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "(π ββ©Cβ©F cf_const π π
π)β¦ObjMapβ¦ = cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms(4) show "(π ββ©Cβ©F cf_const π π
π)β¦ObjMapβ¦β¦aβ¦ =
cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: assms(4) cat_cs_intros)
from assms(4) have ArrMap_dom_lhs:
"πβ©β ((π ββ©Cβ©F cf_const π π
π)β¦ArrMapβ¦) = πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(4) have ArrMap_dom_rhs:
"πβ©β (cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦) = πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"(π ββ©Cβ©F cf_const π π
π)β¦ArrMapβ¦ = cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix a assume "a ββ©β πβ¦Arrβ¦"
with assms(4) show "(π ββ©Cβ©F cf_const π π
π)β¦ArrMapβ¦β¦aβ¦ =
cf_const π β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: assms(4) cat_cs_intros)
qed simp_all
lemma cf_ntcf_comp_ntcf_vcomp:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) = (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π β π by (rule assms(2))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(3))
show "π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) = π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)"
by (rule ntcf_ntsmcf_eqI)
(
use assms in
βΉ
cs_concl
cs_simp: smc_cs_simps slicing_commute[symmetric]
cs_intro:
cat_cs_intros
slicing_intros
smcf_ntsmcf_comp_ntsmcf_vcomp
βΊ
)+
qed
subsectionβΉConstant natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III in \cite{mac_lane_categories_2010}.βΊ
definition ntcf_const :: "V β V β V β V"
where "ntcf_const π β f =
[
vconst_on (πβ¦Objβ¦) f,
cf_const π β (ββ¦Domβ¦β¦fβ¦),
cf_const π β (ββ¦Codβ¦β¦fβ¦),
π,
β
]β©β"
textβΉComponents.βΊ
lemma ntcf_const_components:
shows "ntcf_const π β fβ¦NTMapβ¦ = vconst_on (πβ¦Objβ¦) f"
and "ntcf_const π β fβ¦NTDomβ¦ = cf_const π β (ββ¦Domβ¦β¦fβ¦)"
and "ntcf_const π β fβ¦NTCodβ¦ = cf_const π β (ββ¦Codβ¦β¦fβ¦)"
and "ntcf_const π β fβ¦NTDGDomβ¦ = π"
and "ntcf_const π β fβ¦NTDGCodβ¦ = β"
unfolding ntcf_const_def nt_field_simps by (auto simp: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_const_components(1)[folded VLambda_vconst_on]
|vsv ntcf_const_ObjMap_vsv[cat_cs_intros]|
|vdomain ntcf_const_ObjMap_vdomain[cat_cs_simps]|
|app ntcf_const_ObjMap_app[cat_cs_simps]|
lemma ntcf_const_NTMap_ne_vrange:
assumes "πβ¦Objβ¦ β 0"
shows "ββ©β (ntcf_const π β fβ¦NTMapβ¦) = set {f}"
using assms unfolding ntcf_const_components by simp
lemma ntcf_const_NTMap_vempty_vrange:
assumes "πβ¦Objβ¦ = 0"
shows "ββ©β (ntcf_const π β fβ¦NTMapβ¦) = 0"
using assms unfolding ntcf_const_components by simp
subsubsectionβΉConstant natural transformation is a natural transformationβΊ
lemma ntcf_const_is_ntcf:
assumes "category Ξ± π" and "category Ξ± β" and "f : a β¦βββ b"
shows "ntcf_const π β f : cf_const π β a β¦β©Cβ©F cf_const π β b : π β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (ntcf_const π β f)" unfolding ntcf_const_def by auto
show "cf_const π β a : π β¦β¦β©CβΞ±β β"
proof(rule cf_const_is_functor)
from assms(3) show "a ββ©β ββ¦Objβ¦" by (simp add: cat_cs_intros)
qed (auto simp: cat_cs_intros)
from assms(3) show const_b_is_functor:
"cf_const π β b : π β¦β¦β©CβΞ±β β"
by (auto intro: cf_const_is_functor cat_cs_intros)
show "vcard (ntcf_const π β f) = 5β©β"
unfolding ntcf_const_def by (simp add: nat_omega_simps)
show
"ntcf_const π β fβ¦NTMapβ¦β¦a'β¦ :
cf_const π β aβ¦ObjMapβ¦β¦a'β¦ β¦βββ cf_const π β bβ¦ObjMapβ¦β¦a'β¦"
if "a' ββ©β πβ¦Objβ¦" for a'
by (simp add: that assms(3) ntcf_const_components(1) dghm_const_ObjMap_app)
from assms(3) show
"ntcf_const π β fβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ cf_const π β aβ¦ArrMapβ¦β¦f'β¦ =
cf_const π β b β¦ArrMapβ¦β¦f'β¦ ββ©Aβββ ntcf_const π β fβ¦NTMapβ¦β¦a'β¦"
if "f' : a' β¦βπβ b'" for f' a' b'
using that dghm_const_ArrMap_app
by (auto simp: ntcf_const_components cat_cs_intros cat_cs_simps)
qed (use assms(3) in βΉauto simp: ntcf_const_componentsβΊ)
qed
lemma ntcf_const_is_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± β"
and "f : a β¦βββ b"
and "π = cf_const π β a"
and "π
= cf_const π β b"
and "π' = π"
and "β' = β"
shows "ntcf_const π β f : π β¦β©Cβ©F π
: π' β¦β¦β©CβΞ±β β'"
using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_ntcf)
subsubsectionβΉOpposite constant natural transformationβΊ
lemma op_ntcf_ntcf_const[cat_op_simps]:
"op_ntcf (ntcf_const π β f) = ntcf_const (op_cat π) (op_cat β) f"
unfolding
nt_field_simps dghm_field_simps dg_field_simps
dghm_const_def ntcf_const_def op_cat_def op_cf_def op_ntcf_def
by (simp_all add: nat_omega_simps)
subsubsectionβΉFurther propertiesβΊ
lemma ntcf_const_ntcf_vcomp[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± β"
and "g : b β¦βββ c"
and "f : a β¦βββ b"
shows "ntcf_const π β g ββ©Nβ©Tβ©Cβ©F ntcf_const π β f = ntcf_const π β (g ββ©Aβββ f)"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
from assms(3,4) have gf: "g ββ©Aβββ f : a β¦βββ c" by (simp add: cat_cs_intros)
note πβg = ntcf_const_is_ntcf[OF assms(1,2,3)]
and πβf = ntcf_const_is_ntcf[OF assms(1,2,4)]
show ?thesis
proof(rule ntcf_eqI)
from ntcf_const_is_ntcf[OF assms(1,2,3)] ntcf_const_is_ntcf[OF assms(1,2,4)]
show
"ntcf_const π β g ββ©Nβ©Tβ©Cβ©F ntcf_const π β f :
cf_const π β a β¦β©Cβ©F cf_const π β c : π β¦β¦β©CβΞ±β β"
by (rule ntcf_vcomp_is_ntcf)
show
"ntcf_const π β (g ββ©Aβββ f) :
cf_const π β a β¦β©Cβ©F cf_const π β c : π β¦β¦β©CβΞ±β β"
by (rule ntcf_const_is_ntcf[OF assms(1,2) gf])
show "(ntcf_const π β g ββ©Nβ©Tβ©Cβ©F ntcf_const π β f)β¦NTMapβ¦ =
ntcf_const π β (g ββ©Aβββ f)β¦NTMapβ¦"
unfolding ntcf_const_components
proof(rule vsv_eqI, unfold ntcf_vcomp_NTMap_vdomain[OF πβf])
fix a assume prems: "a ββ©β πβ¦Objβ¦"
then show
"(ntcf_const π β g ββ©Nβ©Tβ©Cβ©F ntcf_const π β f)β¦NTMapβ¦β¦aβ¦ =
vconst_on (πβ¦Objβ¦) (g ββ©Aβββ f)β¦aβ¦"
unfolding ntcf_vcomp_NTMap_app[OF πβg πβf prems]
by (simp add: ntcf_const_components)
qed (simp_all add: ntsmcf_vcomp_components)
qed auto
qed
lemma ntcf_id_cf_const[cat_cs_simps]:
assumes "category Ξ± π" and "category Ξ± β" and "c ββ©β ββ¦Objβ¦"
shows "ntcf_id (cf_const π β c) = ntcf_const π β (ββ¦CIdβ¦β¦cβ¦)"
proof(rule ntcf_eqI)
interpret π: category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
from assms show "ntcf_const π β (ββ¦CIdβ¦β¦cβ¦) :
cf_const π β c β¦β©Cβ©F cf_const π β c : π β¦β¦β©CβΞ±β β"
by (auto intro: ntcf_const_is_ntcf)
interpret const_c: is_functor Ξ± π β βΉcf_const π β cβΊ
by (rule cf_const_is_functor) (auto simp: assms(3) cat_cs_intros)
show "ntcf_id (cf_const π β c) :
cf_const π β c β¦β©Cβ©F cf_const π β c : π β¦β¦β©CβΞ±β β"
by (rule const_c.cf_ntcf_id_is_ntcf)
show "ntcf_id (cf_const π β c)β¦NTMapβ¦ = ntcf_const π β (ββ¦CIdβ¦β¦cβ¦)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold ntcf_const_components)
show "vsv (ntcf_id (cf_const π β c)β¦NTMapβ¦)"
unfolding ntcf_id_components by (auto simp: cat_cs_simps intro: vsv_vcomp)
qed (auto simp: cat_cs_simps)
qed simp_all
lemma ntcf_cf_comp_cf_const_right[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "category Ξ± π"
and "b ββ©β π
β¦Objβ¦"
shows "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_const π π
b = ntcf_const π β (πβ¦NTMapβ¦β¦bβ¦)"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret π: category Ξ± π by (rule assms(2))
show ?thesis
proof(rule ntcf_eqI)
from assms(3) show "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_const π π
b :
cf_const π β (πβ¦ObjMapβ¦β¦bβ¦) β¦β©Cβ©F cf_const π β (πβ¦ObjMapβ¦β¦bβ¦) :
π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) show "ntcf_const π β (πβ¦NTMapβ¦β¦bβ¦) :
cf_const π β (πβ¦ObjMapβ¦β¦bβ¦) β¦β©Cβ©F cf_const π β (πβ¦ObjMapβ¦β¦bβ¦) :
π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have dom_lhs:
"πβ©β ((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_const π π
b)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have dom_rhs:
"πβ©β (ntcf_const π β (πβ¦NTMapβ¦β¦bβ¦)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_const π π
b)β¦NTMapβ¦ = ntcf_const π β (πβ¦NTMapβ¦β¦bβ¦)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms(3) show
"(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_const π π
b)β¦NTMapβ¦β¦aβ¦ =
ntcf_const π β (πβ¦NTMapβ¦β¦bβ¦)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros)
qed simp_all
qed
lemma cf_ntcf_comp_ntcf_id[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π = ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π π
π by (rule assms(2))
show ?thesis
proof(rule ntcf_eqI)
show "π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π : π ββ©Cβ©F π β¦β©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π : π ββ©Cβ©F π β¦β©Cβ©F π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
have dom_lhs: "πβ©β ((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_rhs: "πβ©β ((ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦ = (ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
then show
"(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦ =
(ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
qed
subsectionβΉNatural isomorphismβΊ
textβΉSee Chapter I-4 in \cite{mac_lane_categories_2010}.βΊ
locale is_iso_ntcf = is_ntcf +
assumes iso_ntcf_is_arr_isomorphism[cat_arrow_cs_intros]:
"a ββ©β πβ¦Objβ¦ βΉ πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦"
syntax "_is_iso_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ : _ β¦β©Cβ©Fβ©.β©iβ©sβ©o _ : _ β¦β¦β©CΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
" β
"CONST is_iso_ntcf Ξ± π π
π π π"
lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism':
assumes "a ββ©β πβ¦Objβ¦"
and "A = πβ¦ObjMapβ¦β¦aβ¦"
and "B = πβ¦ObjMapβ¦β¦aβ¦"
shows "πβ¦NTMapβ¦β¦aβ¦ : A β¦β©iβ©sβ©oβπ
β B"
using assms by (auto intro: cat_arrow_cs_intros)
lemmas [cat_arrow_cs_intros] =
is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
lemma (in is_iso_ntcf) iso_ntcf_is_arr_isomorphism'':
assumes "a ββ©β πβ¦Objβ¦"
and "A = πβ¦ObjMapβ¦β¦aβ¦"
and "B = πβ¦ObjMapβ¦β¦aβ¦"
and "F = πβ¦NTMapβ¦β¦aβ¦"
and "π
' = π
"
shows "F : A β¦β©iβ©sβ©oβπ
'β B"
using assms by (auto intro: cat_arrow_cs_intros)
textβΉRules.βΊ
lemma (in is_iso_ntcf) is_iso_ntcf_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π' = π" and "π' = π" and "π
' = π
"
shows "π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±'β π
'"
unfolding assms by (rule is_iso_ntcf_axioms)
mk_ide rf is_iso_ntcf_def[unfolded is_iso_ntcf_axioms_def]
|intro is_iso_ntcfI|
|dest is_iso_ntcfD[dest]|
|elim is_iso_ntcfE[elim]|
lemmas [ntcf_cs_intros] = is_iso_ntcfD(1)
subsectionβΉInverse natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition inv_ntcf :: "V β V"
where "inv_ntcf π =
[
(Ξ»aββ©βπβ¦NTDGDomβ¦β¦Objβ¦. SOME g. is_inverse (πβ¦NTDGCodβ¦) g (πβ¦NTMapβ¦β¦aβ¦)),
πβ¦NTCodβ¦,
πβ¦NTDomβ¦,
πβ¦NTDGDomβ¦,
πβ¦NTDGCodβ¦
]β©β"
textβΉSlicing.βΊ
lemma inv_ntcf_components:
shows "inv_ntcf πβ¦NTMapβ¦ =
(Ξ»aββ©βπβ¦NTDGDomβ¦β¦Objβ¦. SOME g. is_inverse (πβ¦NTDGCodβ¦) g (πβ¦NTMapβ¦β¦aβ¦))"
and [cat_cs_simps]: "inv_ntcf πβ¦NTDomβ¦ = πβ¦NTCodβ¦"
and [cat_cs_simps]: "inv_ntcf πβ¦NTCodβ¦ = πβ¦NTDomβ¦"
and [cat_cs_simps]: "inv_ntcf πβ¦NTDGDomβ¦ = πβ¦NTDGDomβ¦"
and [cat_cs_simps]: "inv_ntcf πβ¦NTDGCodβ¦ = πβ¦NTDGCodβ¦"
unfolding inv_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)
textβΉComponents.βΊ
lemma (in is_iso_ntcf) is_iso_ntcf_inv_ntcf_components[cat_cs_simps]:
"inv_ntcf πβ¦NTDomβ¦ = π"
"inv_ntcf πβ¦NTCodβ¦ = π"
"inv_ntcf πβ¦NTDGDomβ¦ = π"
"inv_ntcf πβ¦NTDGCodβ¦ = π
"
unfolding inv_ntcf_components by (simp_all add: cat_cs_simps)
subsubsectionβΉNatural transformation mapβΊ
lemma inv_ntcf_NTMap_vsv[cat_cs_intros]: "vsv (inv_ntcf πβ¦NTMapβ¦)"
unfolding inv_ntcf_components by auto
lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_inverse[cat_cs_intros]:
assumes "a ββ©β πβ¦Objβ¦"
shows "is_inverse π
(inv_ntcf πβ¦NTMapβ¦β¦aβ¦) (πβ¦NTMapβ¦β¦aβ¦)"
proof-
from assms is_iso_ntcf_axioms have "βg. is_inverse π
g (πβ¦NTMapβ¦β¦aβ¦)" by auto
from assms someI2_ex[OF this] show
"is_inverse π
(inv_ntcf πβ¦NTMapβ¦β¦aβ¦) (πβ¦NTMapβ¦β¦aβ¦)"
unfolding inv_ntcf_components by (simp add: cat_cs_simps)
qed
lemma (in is_iso_ntcf) iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse[cat_cs_intros]:
assumes "a ββ©β πβ¦Objβ¦"
shows "inv_ntcf πβ¦NTMapβ¦β¦aβ¦ = (πβ¦NTMapβ¦β¦aβ¦)Β―β©Cβπ
β"
proof-
have "is_inverse π
(inv_ntcf πβ¦NTMapβ¦β¦aβ¦) (πβ¦NTMapβ¦β¦aβ¦)"
by (rule iso_ntcf_inv_ntcf_NTMap_app_is_inverse[OF assms])
from NTDom.HomCod.cat_is_inverse_eq_the_inverse[OF this] show ?thesis .
qed
lemmas [cat_cs_simps] = is_iso_ntcf.iso_ntcf_inv_ntcf_NTMap_app_is_the_inverse
lemma (in is_ntcf) inv_ntcf_NTMap_vdomain[cat_cs_simps]:
"πβ©β (inv_ntcf πβ¦NTMapβ¦) = πβ¦Objβ¦"
unfolding inv_ntcf_components by (simp add: cat_cs_simps)
lemmas [cat_cs_simps] = is_ntcf.inv_ntcf_NTMap_vdomain
lemma (in is_iso_ntcf) inv_ntcf_NTMap_vrange:
"ββ©β (inv_ntcf πβ¦NTMapβ¦) ββ©β π
β¦Arrβ¦"
proof(rule vsubsetI)
interpret inv_π: vsv βΉinv_ntcf πβ¦NTMapβ¦βΊ by (rule inv_ntcf_NTMap_vsv)
fix f assume "f ββ©β ββ©β (inv_ntcf πβ¦NTMapβ¦)"
then obtain a
where f_def: "f = inv_ntcf πβ¦NTMapβ¦β¦aβ¦" and "a ββ©β πβ©β (inv_ntcf πβ¦NTMapβ¦)"
by (blast elim: inv_π.vrange_atE)
then have "a ββ©β πβ¦Objβ¦" by (simp add: cat_cs_simps)
then have "is_inverse π
f (πβ¦NTMapβ¦β¦aβ¦)"
unfolding f_def by (intro iso_ntcf_inv_ntcf_NTMap_app_is_inverse)
then show "f ββ©β π
β¦Arrβ¦" by auto
qed
subsubsectionβΉOpposite natural isomorphismβΊ
lemma (in is_iso_ntcf) is_iso_ntcf_op:
"op_ntcf π : op_cf π β¦β©Cβ©Fβ©.β©iβ©sβ©o op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat π
"
proof-
from is_iso_ntcf_axioms have
"op_ntcf π : op_cf π β¦β©Cβ©F op_cf π : op_cat π β¦β¦β©CβΞ±β op_cat π
"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
then show ?thesis
by (intro is_iso_ntcfI) (auto simp: cat_op_simps cat_arrow_cs_intros)
qed
lemma (in is_iso_ntcf) is_iso_ntcf_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cat π"
and "π
' = op_cat π
"
shows "op_ntcf π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule is_iso_ntcf_op)
lemmas is_iso_ntcf_op[cat_op_intros] = is_iso_ntcf.is_iso_ntcf_op
subsectionβΉA natural isomorphism is an isomorphism in the category βΉFunctβΊβΊ
textβΉ
The results that are presented in this subsection can be found in
nLab (see \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/natural+isomorphism
}}).
βΊ
lemma is_arr_isomorphism_is_iso_ntcf:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
and "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
shows "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
proof-
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(rule is_iso_ntcfI)
fix a assume prems: "a ββ©β πβ¦Objβ¦"
show "πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦"
proof(rule is_arr_isomorphismI)
show "is_inverse π
(πβ¦NTMapβ¦β¦aβ¦) (πβ¦NTMapβ¦β¦aβ¦)"
proof(rule is_inverseI)
from prems have
"πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦ = (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦"
by (simp add: ntcf_vcomp_NTMap_app[OF assms(2,1) prems])
also have "β¦ = ntcf_id πβ¦NTMapβ¦β¦aβ¦" unfolding assms(4) by simp
also from prems π.NTDom.ntcf_id_NTMap_app_vdomain have
"β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
unfolding ntcf_id_components by auto
finally show "πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦".
from prems have
"πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦ = (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦"
by (simp add: ntcf_vcomp_NTMap_app[OF assms(1,2) prems])
also have "β¦ = ntcf_id πβ¦NTMapβ¦β¦aβ¦" unfolding assms(3) by simp
also from prems π.NTCod.ntcf_id_NTMap_app_vdomain have
"β¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
unfolding ntcf_id_components by auto
finally show "πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦".
qed (auto simp: prems cat_cs_intros)
qed (auto simp: prems cat_cs_intros)
qed (auto simp: cat_cs_intros)
qed
lemma iso_ntcf_is_arr_isomorphism:
assumes "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
shows [ntcf_cs_intros]: "inv_ntcf π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π"
and "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
proof-
interpret is_iso_ntcf Ξ± π π
π π π by (rule assms(1))
define m where "m a = inv_ntcf πβ¦NTMapβ¦β¦aβ¦" for a
have is_inverse[intro]: "a ββ©β πβ¦Objβ¦ βΉ is_inverse π
(m a) (πβ¦NTMapβ¦β¦aβ¦)"
for a
unfolding m_def by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have [dest, intro, simp]:
"a ββ©β πβ¦Objβ¦ βΉ m a : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦" for a
proof-
assume prems: "a ββ©β πβ¦Objβ¦"
from prems have "πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦"
by (auto intro: cat_cs_intros cat_arrow_cs_intros)
with is_inverse[OF prems] show "m a : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦"
by
(
meson
NTDom.HomCod.cat_is_inverse_is_arr_isomorphism is_arr_isomorphismD
)
qed
have [intro]:
"f : a β¦βπβ b βΉ m b ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β m a"
for f a b
proof-
assume prems: "f : a β¦βπβ b"
then have ma: "m a : πβ¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦aβ¦"
and mb: "m b : πβ¦ObjMapβ¦β¦bβ¦ β¦β©iβ©sβ©oβπ
β πβ¦ObjMapβ¦β¦bβ¦"
and πf: "πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and πa: "πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and πf: "πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and πb: "πβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
by (auto intro: cat_cs_intros)
then have πbπf:
"πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
by (auto intro: cat_cs_intros)
from prems have inv_ma: "is_inverse π
(m a) (πβ¦NTMapβ¦β¦aβ¦)"
and inv_mb: "is_inverse π
(πβ¦NTMapβ¦β¦bβ¦) (m b)"
by (auto simp: is_inverse_sym)
from mb have mb_πb: "m b ββ©Aβπ
β πβ¦NTMapβ¦β¦bβ¦ = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦bβ¦β¦"
by (auto intro: is_inverse_Comp_CId_right[OF inv_mb])
from prems have πa_ma: "πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β m a = π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦"
using πa inv_ma ma by (meson is_inverse_Comp_CId_right)
from πf have "m b ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ =
m b ββ©Aβπ
β (πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β (πβ¦NTMapβ¦β¦aβ¦ ββ©Aβπ
β m a))"
unfolding πa_ma by (cs_concl cs_simp: cat_cs_simps)
also have "β¦ = m b ββ©Aβπ
β ((πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β πβ¦NTMapβ¦β¦aβ¦) ββ©Aβπ
β m a)"
by
(
metis
ma πf πa NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
)
also from prems have
"β¦ = m b ββ©Aβπ
β ((πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦) ββ©Aβπ
β m a)"
by (metis ntcf_Comp_commute)
also have "β¦ = (m b ββ©Aβπ
β (πβ¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦)) ββ©Aβπ
β m a"
by
(
metis
πbπf ma mb NTDom.HomCod.cat_Comp_assoc is_arr_isomorphismD(1)
)
also from πf πb mb NTDom.HomCod.cat_Comp_assoc have
"β¦ = ((m b ββ©Aβπ
β πβ¦NTMapβ¦β¦bβ¦) ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦) ββ©Aβπ
β m a"
by (metis is_arr_isomorphismD(1))
also from πf have "β¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β m a"
unfolding mb_πb by (simp add: cat_cs_simps)
finally show "m b ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β m a" by simp
qed
show π: "inv_ntcf π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
proof(intro is_iso_ntcfI is_ntcfI', unfold m_def[symmetric])
show "vfsequence (inv_ntcf π)" unfolding inv_ntcf_def by simp
show "vcard (inv_ntcf π) = 5β©β"
unfolding inv_ntcf_def by (simp add: nat_omega_simps)
qed (auto simp: cat_cs_simps intro: cat_cs_intros)
interpret π: is_iso_ntcf Ξ± π π
π π βΉinv_ntcf πβΊ by (rule π)
show ππ: "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π"
proof(rule ntcf_eqI)
from NTCod.cf_ntcf_id_is_ntcf show "ntcf_id π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
show "(π ββ©Nβ©Tβ©Cβ©F inv_ntcf π)β¦NTMapβ¦ = ntcf_id πβ¦NTMapβ¦"
proof(rule vsv_eqI)
fix a assume "a ββ©β πβ©β ((π ββ©Nβ©Tβ©Cβ©F inv_ntcf π)β¦NTMapβ¦)"
then have "a ββ©β πβ¦Objβ¦"
unfolding ntcf_vcomp_NTMap_vdomain[OF π.is_ntcf_axioms] by simp
then show "(π ββ©Nβ©Tβ©Cβ©F inv_ntcf π)β¦NTMapβ¦β¦aβ¦ = ntcf_id πβ¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
qed
(
auto
simp: ntsmcf_vcomp_components(1) cat_cs_simps
intro: cat_cs_intros
)
qed (auto intro: cat_cs_intros)
show ππ: "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
proof(rule ntcf_eqI)
show "(inv_ntcf π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ = ntcf_id πβ¦NTMapβ¦"
proof(rule vsv_eqI)
show "πβ©β ((inv_ntcf π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) = πβ©β (ntcf_id πβ¦NTMapβ¦)"
by (simp add: ntsmcf_vcomp_components(1) cat_cs_simps)
fix a assume "a ββ©β πβ©β ((inv_ntcf π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦)"
then have "a ββ©β πβ¦Objβ¦"
unfolding ntsmcf_vcomp_components by (simp add: cat_cs_simps)
then show "(inv_ntcf π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦aβ¦ = ntcf_id πβ¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
qed
(
auto simp:
ntsmcf_vcomp_components(1)
ntcf_id_components(1)
cat_cs_simps
intro: vsv_vcomp
)
qed (auto intro: cat_cs_intros)
qed
subsubsectionβΉVertical composition of natural isomorphismsβΊ
lemma ntcf_vcomp_is_iso_ntcf[cat_cs_intros]:
assumes "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o β : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o β : π β¦β¦β©CβΞ±β π
"
proof(intro is_arr_isomorphism_is_iso_ntcf)
note inv_ntcf_π = iso_ntcf_is_arr_isomorphism[OF assms(1)]
and inv_ntcf_π = iso_ntcf_is_arr_isomorphism[OF assms(2)]
note [cat_cs_simps] = inv_ntcf_π(2,3) inv_ntcf_π(2,3)
from assms show "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
from inv_ntcf_π(1) inv_ntcf_π(1) show
"inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π : β β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
from assms inv_ntcf_π(1) inv_ntcf_π(1) have
"π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π) =
π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F inv_ntcf π) ββ©Nβ©Tβ©Cβ©F inv_ntcf π"
by
(
cs_concl
cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
)
also from assms have "β¦ = ntcf_id β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
finally show "π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π) = ntcf_id β"
by simp
from assms inv_ntcf_π(1) inv_ntcf_π(1) have
"inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) =
inv_ntcf π ββ©Nβ©Tβ©Cβ©F (inv_ntcf π ββ©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F π"
by
(
cs_concl
cs_simp: ntcf_vcomp_assoc cs_intro: cat_cs_intros ntcf_cs_intros
)
also from assms have "β¦ = ntcf_id π"
by (cs_concl cs_simp: cat_cs_simps cs_intro: ntcf_cs_intros)
finally show "inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) = ntcf_id π"
by simp
qed
subsubsectionβΉHorizontal composition of natural isomorphismsβΊ
lemma ntcf_hcomp_is_iso_ntcf:
assumes "π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π' ββ©Cβ©F π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
proof(intro is_arr_isomorphism_is_iso_ntcf)
note inv_ntcf_π = iso_ntcf_is_arr_isomorphism[OF assms(1)]
and inv_ntcf_π = iso_ntcf_is_arr_isomorphism[OF assms(2)]
note [cat_cs_simps] = inv_ntcf_π(2,3) inv_ntcf_π(2,3)
from assms show "π ββ©Nβ©Tβ©Cβ©F π : π' ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
from inv_ntcf_π(1) inv_ntcf_π(1) show
"inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π : π' ββ©Cβ©F π β¦β©Cβ©F π' ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
from assms inv_ntcf_π(1) inv_ntcf_π(1) have
"π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π) =
ntcf_id π' ββ©Nβ©Tβ©Cβ©F ntcf_id π"
by
(
cs_concl
cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
cs_intro: ntcf_cs_intros
)
also from assms have "β¦ = ntcf_id (π' ββ©Cβ©F π)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
finally show
"π ββ©Nβ©Tβ©Cβ©F π ββ©Nβ©Tβ©Cβ©F (inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π) = ntcf_id (π' ββ©Cβ©F π)"
by simp
from assms inv_ntcf_π(1) inv_ntcf_π(1) have
"inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) =
ntcf_id π' ββ©Nβ©Tβ©Cβ©F ntcf_id π"
by
(
cs_concl
cs_simp: ntcf_comp_interchange_law[symmetric] cat_cs_simps
cs_intro: ntcf_cs_intros
)
also from assms have "β¦ = ntcf_id (π' ββ©Cβ©F π)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
finally show
"inv_ntcf π ββ©Nβ©Tβ©Cβ©F inv_ntcf π ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©F π) = ntcf_id (π' ββ©Cβ©F π)"
by simp
qed
lemma ntcf_hcomp_is_iso_ntcf'[ntcf_cs_intros]:
assumes "π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "β' = π' ββ©Cβ©F π"
and "β'' = π' ββ©Cβ©F π"
shows "π ββ©Nβ©Tβ©Cβ©F π : β' β¦β©Cβ©Fβ©.β©iβ©sβ©o β'' : π β¦β¦β©CβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (rule ntcf_hcomp_is_iso_ntcf)
subsubsectionβΉAn identity natural transformation is a natural isomorphismβΊ
lemma (in is_functor) cf_ntcf_id_is_iso_ntcf:
"ntcf_id π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
proof-
have "ntcf_id π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by (auto intro: cat_cs_intros)
moreover then have "ntcf_id π ββ©Nβ©Tβ©Cβ©F ntcf_id π = ntcf_id π"
by (cs_concl cs_simp: cat_cs_simps)
ultimately show ?thesis by (auto intro: is_arr_isomorphism_is_iso_ntcf)
qed
lemma (in is_functor) cf_ntcf_id_is_iso_ntcf'[ntcf_cs_intros]:
assumes "π' = π" and "β' = π"
shows "ntcf_id π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o β' : π β¦β¦β©CβΞ±β π
"
unfolding assms by (rule cf_ntcf_id_is_iso_ntcf)
lemmas [ntcf_cs_intros] = is_functor.cf_ntcf_id_is_iso_ntcf'
subsectionβΉFunctor isomorphismβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee subsection 1.5 in \cite{bodo_categories_1970}.βΊ
locale iso_functor =
fixes Ξ± π π
assumes iso_cf_is_iso_ntcf: "βπ π
π. π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
notation iso_functor (infixl "ββ©Cβ©FΔ±" 50)
textβΉRules.βΊ
lemma iso_functorI:
assumes "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Cβ©FβΞ±β π"
using assms unfolding iso_functor_def by auto
lemma iso_functorD[dest]:
assumes "π ββ©Cβ©FβΞ±β π"
shows "βπ π
π. π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
using assms unfolding iso_functor_def by auto
lemma iso_functorE[elim]:
assumes "π ββ©Cβ©FβΞ±β π"
obtains π π
π where "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
using assms unfolding iso_functor_def by auto
subsubsectionβΉA functor isomorphism is an equivalence relationβΊ
lemma iso_functor_refl:
assumes "π : π β¦β¦β©CβΞ±β π
"
shows "π ββ©Cβ©FβΞ±β π"
proof(rule iso_functorI)
from assms show "ntcf_id π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: ntcf_cs_intros)
qed
lemma iso_functor_sym[sym]:
assumes "π ββ©Cβ©FβΞ±β π"
shows "π ββ©Cβ©FβΞ±β π"
proof-
from assms obtain π π
π where π: "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
" by auto
from iso_ntcf_is_arr_isomorphism(1)[OF π] show "π ββ©Cβ©FβΞ±β π"
by (auto simp: iso_functorI)
qed
lemma iso_functor_trans[trans, intro]:
assumes "π ββ©Cβ©FβΞ±β π" and "π ββ©Cβ©FβΞ±β β"
shows "π ββ©Cβ©FβΞ±β β"
proof-
from assms(1) obtain π π
π where π: "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
by auto
moreover from assms(2) obtain π' π
' π
where π: "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o β : π' β¦β¦β©CβΞ±β π
'"
by auto
ultimately have "π : π' β¦β¦β©CβΞ±β π
'" and "π : π β¦β¦β©CβΞ±β π
" by blast+
then have eq: "π' = π" "π
' = π
" by auto
from π have π: "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o β : π β¦β¦β©CβΞ±β π
" unfolding eq .
from ntcf_vcomp_is_iso_ntcf[OF π π] show ?thesis by (rule iso_functorI)
qed
subsubsectionβΉOpposite functor isomorphismβΊ
lemma (in iso_functor) iso_functor_op: "op_cf π ββ©Cβ©FβΞ±β op_cf π"
proof-
from iso_functor_axioms obtain π π
π where "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
by auto
from is_iso_ntcf_op[OF this] have "op_cf π ββ©Cβ©FβΞ±β op_cf π"
by (auto simp: iso_functorI)
then show "op_cf π ββ©Cβ©FβΞ±β op_cf π" by (rule iso_functor_sym)
qed
lemmas iso_functor_op[cat_op_intros] = iso_functor.iso_functor_op
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Small_NTCF
sectionβΉSmallness for natural transformationsβΊ
theory CZH_ECAT_Small_NTCF
imports
CZH_Foundations.CZH_SMC_Small_NTSMCF
CZH_ECAT_Small_Functor
CZH_ECAT_NTCF
begin
subsectionβΉNatural transformation of functors with tiny mapsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_tm_ntcf = is_ntcf Ξ± π π
π π π for Ξ± π π
π π π +
assumes tm_ntcf_is_tm_ntsmcf: "ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©m cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π
"
syntax "_is_tm_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ β¦β©Cβ©Fβ©.β©tβ©m _ :/ _ β¦β¦β©Cβ©.β©tβ©mΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
" β
"CONST is_tm_ntcf Ξ± π π
π π π"
abbreviation all_tm_ntcfs :: "V β V"
where "all_tm_ntcfs Ξ± β‘
set {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
abbreviation tm_ntcfs :: "V β V β V β V"
where "tm_ntcfs Ξ± π π
β‘
set {π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
abbreviation these_tm_ntcfs :: "V β V β V β V β V β V"
where "these_tm_ntcfs Ξ± π π
π π β‘
set {π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
lemma (in is_tm_ntcf) tm_ntcf_is_tm_ntsmcf':
assumes "π' = cf_smcf π"
and "π' = cf_smcf π"
and "π' = cat_smc π"
and "π
' = cat_smc π
"
shows "ntcf_ntsmcf π : π' β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©m π' : π' β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β π
'"
unfolding assms by (rule tm_ntcf_is_tm_ntsmcf)
lemmas [slicing_intros] = is_tm_ntcf.tm_ntcf_is_tm_ntsmcf'
textβΉRules.βΊ
lemma (in is_tm_ntcf) is_tm_ntcf_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
" and "π' = π" and "π' = π"
shows "π : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β π
'"
unfolding assms by (rule is_tm_ntcf_axioms)
mk_ide rf is_tm_ntcf_def[unfolded is_tm_ntcf_axioms_def]
|intro is_tm_ntcfI|
|dest is_tm_ntcfD[dest]|
|elim is_tm_ntcfE[elim]|
lemmas [cat_small_cs_intros] = is_tm_ntcfD(1)
context is_tm_ntcf
begin
interpretation ntsmcf: is_tm_ntsmcf
Ξ± βΉcat_smc πβΊ βΉcat_smc π
βΊ βΉcf_smcf πβΊ βΉcf_smcf πβΊ βΉntcf_ntsmcf πβΊ
by (rule tm_ntcf_is_tm_ntsmcf)
lemmas_with [unfolded slicing_simps]:
tm_ntcf_NTMap_in_Vset = ntsmcf.tm_ntsmcf_NTMap_in_Vset
end
sublocale is_tm_ntcf β NTDom: is_tm_functor Ξ± π π
π
using tm_ntcf_is_tm_ntsmcf
by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')
sublocale is_tm_ntcf β NTCod: is_tm_functor Ξ± π π
π
using tm_ntcf_is_tm_ntsmcf
by (intro is_tm_functorI) (auto intro: cat_cs_intros is_tm_ntsmcfD')
textβΉFurther rules.βΊ
lemma is_tm_ntcfI':
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof-
interpret is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_tm_functor Ξ± π π
π by (rule assms(2))
interpret π: is_tm_functor Ξ± π π
π by (rule assms(3))
show ?thesis
proof(intro is_tm_ntcfI)
show "ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©m cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©mβΞ±β cat_smc π
"
by (intro is_tm_ntsmcfI') (auto intro: slicing_intros)
qed (auto intro: cat_cs_intros)
qed
lemma is_tm_ntcfD':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof-
interpret is_tm_ntcf Ξ± π π
π π π by (rule assms(1))
show "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (auto simp: cat_small_cs_intros)
qed
lemmas [cat_small_cs_intros] = is_tm_ntcfD'(2,3)
lemma is_tm_ntcfE':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
obtains "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
using is_tm_ntcfD'[OF assms] by auto
textβΉThe set of all natural transformations with tiny maps is small.βΊ
lemma small_all_tm_ntcfs[simp]:
"small {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
proof(rule down)
show
"{π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
} β
elts (set {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
})"
proof
(
simp only: elts_of_set small_all_ntcfs if_True,
rule subsetI,
unfold mem_Collect_eq
)
fix π assume "βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
then obtain π π π π
where "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by clarsimp
then interpret is_tm_ntcf Ξ± π π
π π π by simp
have "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by (auto simp: cat_cs_intros)
then show "βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by auto
qed
qed
lemma small_tm_ntcfs[simp]:
"small {π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}βΊ])
auto
lemma small_these_tm_ntcfs[simp]:
"small {π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
by (rule down[of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}βΊ])
auto
textβΉFurther elementary results.βΊ
lemma these_tm_ntcfs_iff:
"π ββ©β these_tm_ntcfs Ξ± π π
π π β· π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by auto
subsubsectionβΉOpposite natural transformation of functors with tiny mapsβΊ
lemma (in is_tm_ntcf) is_tm_ntcf_op: "op_ntcf π :
op_cf π β¦β©Cβ©Fβ©.β©tβ©m op_cf π : op_cat π β¦β¦β©Cβ©.β©tβ©mβΞ±β op_cat π
"
by (intro is_tm_ntcfI')
(cs_concl cs_intro: cat_cs_intros cat_op_intros)+
lemma (in is_tm_ntcf) is_tm_ntcf_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cat π"
and "π
' = op_cat π
"
shows "op_ntcf π : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β π
'"
unfolding assms by (rule is_tm_ntcf_op)
lemmas is_tm_ntcf_op[cat_op_intros] = is_tm_ntcf.is_tm_ntcf_op'
subsubsectionβΉ
Vertical composition of natural transformations of
functors with tiny maps
βΊ
lemma ntcf_vcomp_is_tm_ntcf[cat_small_cs_intros]:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m β : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©Fβ©.β©tβ©m β : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof-
interpret π: is_tm_ntcf Ξ± π π
π β π by (rule assms(1))
interpret π: is_tm_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
qed
subsubsectionβΉIdentity natural transformation of a functor with tiny mapsβΊ
lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf:
"ntcf_id π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
lemma (in is_tm_functor) tm_cf_ntcf_id_is_tm_ntcf':
assumes "π' = π" and "π' = π"
shows "ntcf_id π : π' β¦β©Cβ©Fβ©.β©tβ©m π': π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
unfolding assms(1,2) by (rule tm_cf_ntcf_id_is_tm_ntcf)
lemmas [cat_small_cs_intros] = is_tm_functor.tm_cf_ntcf_id_is_tm_ntcf'
subsubsectionβΉConstant natural transformation of functors with tiny mapsβΊ
lemma ntcf_const_is_tm_ntcf:
assumes "tiny_category Ξ± π" and "category Ξ± β" and "f : a β¦βββ b"
shows "ntcf_const π β f :
cf_const π β a β¦β©Cβ©Fβ©.β©tβ©m cf_const π β b : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
(is βΉ?Cf : ?Ca β¦β©Cβ©Fβ©.β©tβ©m ?Cb : π β¦β¦β©Cβ©.β©tβ©mβΞ±β ββΊ)
proof(intro is_tm_ntcfI')
interpret π: tiny_category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
from assms show
"?Cf : ?Ca β¦β©Cβ©F ?Cb : π β¦β¦β©CβΞ±β β"
"cf_const π β a : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
"cf_const π β b : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
qed
lemma ntcf_const_is_tm_ntcf'[cat_small_cs_intros]:
assumes "tiny_category Ξ± π"
and "category Ξ± β"
and "f : a β¦βββ b"
and "π = cf_const π β a"
and "π
= cf_const π β b"
and "π' = π"
and "β' = β"
shows "ntcf_const π β f : π β¦β©Cβ©Fβ©.β©tβ©m π
: π' β¦β¦β©Cβ©.β©tβ©mβΞ±β β'"
using assms(1-3) unfolding assms(4-7) by (rule ntcf_const_is_tm_ntcf)
subsubsectionβΉNatural isomorphisms of functors with tiny mapsβΊ
locale is_tm_iso_ntcf = is_iso_ntcf Ξ± π π
π π π + is_tm_ntcf Ξ± π π
π π π
for Ξ± π π
π π π
syntax "_is_tm_iso_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ : _ β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o _ : _ β¦β¦β©Cβ©.β©tβ©mΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
" β
"CONST is_tm_iso_ntcf Ξ± π π
π π π"
textβΉRules.βΊ
mk_ide rf is_tm_iso_ntcf_def
|intro is_tm_iso_ntcfI|
|dest is_tm_iso_ntcfD[dest]|
|elim is_tm_iso_ntcfE[elim]|
lemmas [ntcf_cs_intros] = is_tm_iso_ntcfD
lemma iso_tm_ntcf_is_arr_isomorphism:
assumes "category Ξ± π
" and "π : π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows [ntcf_cs_intros]: "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π"
and "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
proof-
interpret π
: category Ξ± π
by (rule assms(1))
interpret π: is_tm_iso_ntcf Ξ± π π
π π π by (rule assms)
note inv_π = iso_ntcf_is_arr_isomorphism[OF π.is_iso_ntcf_axioms]
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof(intro is_tm_iso_ntcfI)
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
" by (intro inv_π(1))
interpret inv_π: is_iso_ntcf Ξ± π π
π π βΉinv_ntcf πβΊ by (rule inv_π(1))
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (intro is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
qed
show "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π" "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
by (intro inv_π(2,3))+
qed
lemma is_arr_isomorphism_is_tm_iso_ntcf:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and [simp]: "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
and [simp]: "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof-
interpret π: is_tm_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_tm_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(rule is_tm_iso_ntcfI)
show "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
show "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (rule is_tm_ntcfI')
(auto simp: π.tm_ntcf_NTMap_in_Vset intro: cat_small_cs_intros)
qed
qed
subsubsectionβΉ
Composition of a natural transformation
of functors with tiny maps and a functor with tiny maps
βΊ
lemma ntcf_cf_comp_is_tm_ntcf:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "β : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β : π ββ©Cβ©F β β¦β©Cβ©Fβ©.β©tβ©m π ββ©Cβ©F β : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof-
interpret π: is_tm_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_tm_functor Ξ± π π
β by (rule assms(2))
from assms show ?thesis
by (intro is_tm_ntcfI)
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
)+
qed
lemma ntcf_cf_comp_is_tm_ntcf'[cat_small_cs_intros]:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "β : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π' = π ββ©Cβ©F β"
and "π' = π ββ©Cβ©F β"
shows "π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (rule ntcf_cf_comp_is_tm_ntcf)
subsubsectionβΉ
Composition of a functor with tiny maps
and a natural transformation of functors with tiny maps
βΊ
lemma cf_ntcf_comp_is_tm_ntcf:
assumes "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π : β ββ©Cβ©F π β¦β©Cβ©Fβ©.β©tβ©m β ββ©Cβ©F π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof-
interpret β: is_tm_functor Ξ± π
β β by (rule assms(1))
interpret π: is_tm_ntcf Ξ± π π
π π π by (rule assms(2))
from assms show ?thesis
by (intro is_tm_ntcfI)
(
cs_concl
cs_simp: slicing_commute[symmetric]
cs_intro: cat_cs_intros smc_small_cs_intros slicing_intros
)+
qed
lemma cf_ntcf_comp_is_tm_ntcf'[cat_small_cs_intros]:
assumes "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π' = β ββ©Cβ©F π"
and "π' = β ββ©Cβ©F π"
shows "β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
using assms(1,2) unfolding assms(3,4) by (rule cf_ntcf_comp_is_tm_ntcf)
subsectionβΉTiny natural transformation of functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_tiny_ntcf = is_ntcf Ξ± π π
π π π for Ξ± π π
π π π +
assumes tiny_ntcf_is_tiny_ntsmcf:
"ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©iβ©nβ©y cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ±β cat_smc π
"
syntax "_is_tiny_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ :/ _ β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y _ :/ _ β¦β¦β©Cβ©.β©tβ©iβ©nβ©yΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" β
"CONST is_tiny_ntcf Ξ± π π
π π π"
abbreviation all_tiny_ntcfs :: "V β V"
where "all_tiny_ntcfs Ξ± β‘
set {π. βπ π
π π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
abbreviation tiny_ntcfs :: "V β V β V β V"
where "tiny_ntcfs Ξ± π π
β‘
set {π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
abbreviation these_tiny_ntcfs :: "V β V β V β V β V β V"
where "these_tiny_ntcfs Ξ± π π
π π β‘
set {π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
lemma (in is_tiny_ntcf) tiny_ntcf_is_tiny_ntsmcf':
assumes "Ξ±' = Ξ±"
and "π' = cf_smcf π"
and "π' = cf_smcf π"
and "π' = cat_smc π"
and "π
' = cat_smc π
"
shows "ntcf_ntsmcf π : π' β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©iβ©nβ©y π' : π' β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ±'β π
'"
unfolding assms by (rule tiny_ntcf_is_tiny_ntsmcf)
lemmas [slicing_intros] = is_tiny_ntcf.tiny_ntcf_is_tiny_ntsmcf'
textβΉRules.βΊ
lemma (in is_tiny_ntcf) is_tiny_ntcf_axioms'[cat_small_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
" and "π' = π" and "π' = π"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
unfolding assms by (rule is_tiny_ntcf_axioms)
mk_ide rf is_tiny_ntcf_def[unfolded is_tiny_ntcf_axioms_def]
|intro is_tiny_ntcfI|
|dest is_tiny_ntcfD[dest]|
|elim is_tiny_ntcfE[elim]|
textβΉElementary properties.βΊ
sublocale is_tiny_ntcf β NTDom: is_tiny_functor Ξ± π π
π
using tiny_ntcf_is_tiny_ntsmcf
by (intro is_tiny_functorI)
(auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)
sublocale is_tiny_ntcf β NTCod: is_tiny_functor Ξ± π π
π
using tiny_ntcf_is_tiny_ntsmcf
by (intro is_tiny_functorI)
(auto intro: cat_cs_intros simp: is_tiny_ntsmcf_iff)
sublocale is_tiny_ntcf β is_tm_ntcf
by (rule is_tm_ntcfI') (auto intro: cat_cs_intros cat_small_cs_intros)
lemmas (in is_tiny_ntcf) tiny_ntcf_is_tm_ntcf[cat_small_cs_intros] =
is_tm_ntcf_axioms
lemmas [cat_small_cs_intros] = is_tiny_ntcf.tiny_ntcf_is_tm_ntcf
textβΉFurther rules.βΊ
lemma is_tiny_ntcfI':
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_tiny_functor Ξ± π π
π by (rule assms(2))
interpret π: is_tiny_functor Ξ± π π
π by (rule assms(3))
show "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (intro is_tiny_ntcfI is_tiny_ntsmcfI')
(auto intro: cat_cs_intros slicing_intros)
qed
lemma is_tiny_ntcfD':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_tiny_ntcf Ξ± π π
π π π by (rule assms(1))
show "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (auto intro: cat_small_cs_intros)
qed
lemmas [cat_small_cs_intros] = is_tiny_ntcfD'(2,3)
lemma is_tiny_ntcfE':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
obtains "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
using assms by (auto dest: is_tiny_ntcfD'(2,3))
lemma is_tiny_ntcf_iff:
"π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
β·
(
π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
β§
π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
β§
π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
)"
by (auto intro: is_tiny_ntcfI' dest: is_tiny_ntcfD'(2,3))
lemma (in is_tiny_ntcf) tiny_ntcf_in_Vset: "π ββ©β Vset Ξ±"
proof-
note [cat_cs_intros] =
tm_ntcf_NTMap_in_Vset
NTDom.tiny_cf_in_Vset
NTCod.tiny_cf_in_Vset
NTDom.HomDom.tiny_cat_in_Vset
NTDom.HomCod.tiny_cat_in_Vset
show ?thesis
by (subst ntcf_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)
qed
lemma small_all_tiny_ntcfs[simp]:
"small {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
proof(rule down)
show "{π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
} β
elts (set {π. βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
})"
proof
(
simp only: elts_of_set small_all_ntcfs if_True,
rule subsetI,
unfold mem_Collect_eq
)
fix π assume "βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
then obtain π π π π
where "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by clarsimp
then interpret is_tiny_ntcf Ξ± π π
π π π .
have "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by (auto intro: cat_cs_intros)
then show "βπ π π π
. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by auto
qed
qed
lemma small_tiny_ntcfs[simp]:
"small {π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
by
(
rule
down[
of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}βΊ
]
)
auto
lemma small_these_tiny_ntcfs[simp]:
"small {π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}"
by
(
rule
down[
of _ βΉset {π. βπ π π π
. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
}βΊ
]
)
auto
lemma tiny_ntcfs_vsubset_Vset[simp]:
"set {π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
} ββ©β Vset Ξ±"
(is βΉset ?ntcfs ββ©β _βΊ)
proof(cases βΉtiny_category Ξ± π β§ tiny_category Ξ± π
βΊ)
case True
then have "tiny_category Ξ± π" and "tiny_category Ξ± π
" by auto
show ?thesis
proof(rule vsubsetI)
fix π assume "π ββ©β set ?ntcfs"
then obtain π π where "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" by auto
then interpret is_tiny_ntcf Ξ± π π
π π π by simp
from tiny_ntcf_in_Vset show "π ββ©β Vset Ξ±" by simp
qed
next
case False
then have "set ?ntcfs = 0"
unfolding is_tiny_ntcf_iff is_tiny_functor_iff by auto
then show ?thesis by simp
qed
textβΉFurther elementary results.βΊ
lemma these_tiny_ntcfs_iff:
"π ββ©β these_tiny_ntcfs Ξ± π π
π π β· π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by auto
textβΉSize.βΊ
lemma (in is_ntcf) ntcf_is_tiny_ntcf_if_ge_Limit:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
"
proof(intro is_tiny_ntcfI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ²β π
"
by (intro ntcf_is_ntcf_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: dg_cs_introsβΊ)+
show "ntcf_ntsmcf π :
cf_smcf π β¦β©Sβ©Mβ©Cβ©Fβ©.β©tβ©iβ©nβ©y cf_smcf π : cat_smc π β¦β¦β©Sβ©Mβ©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_smc π
"
by
(
rule is_ntsmcf.ntsmcf_is_tiny_ntsmcf_if_ge_Limit,
rule ntcf_is_ntsmcf;
intro assms
)
qed
subsubsectionβΉOpposite natural transformation of tiny functorsβΊ
lemma (in is_tiny_ntcf) is_tm_ntcf_op: "op_ntcf π :
op_cf π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y op_cf π : op_cat π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β op_cat π
"
by (intro is_tiny_ntcfI')
(cs_concl cs_intro: cat_cs_intros cat_op_intros)+
lemma (in is_tiny_ntcf) is_tiny_ntcf_op'[cat_op_intros]:
assumes "π' = op_cf π"
and "π' = op_cf π"
and "π' = op_cat π"
and "π
' = op_cat π
"
shows "op_ntcf π : π' β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π' : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
'"
unfolding assms by (rule is_tm_ntcf_op)
lemmas is_tiny_ntcf_op[cat_op_intros] = is_tiny_ntcf.is_tiny_ntcf_op'
subsubsectionβΉVertical composition of tiny natural transformationsβΊ
lemma ntsmcf_vcomp_is_tiny_ntsmcf[cat_small_cs_intros]:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y β : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y β : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_tiny_ntcf Ξ± π π
π β π by (rule assms(1))
interpret π: is_tiny_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
qed
subsubsectionβΉTiny identity natural transformationβΊ
lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf:
"ntcf_id π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
lemma (in is_tiny_functor) tiny_cf_ntcf_id_is_tiny_ntcf'[cat_small_cs_intros]:
assumes "π' = π" and "π' = π"
shows "ntcf_id π : π' β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π' : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
unfolding assms by (rule tiny_cf_ntcf_id_is_tiny_ntcf)
lemmas [cat_small_cs_intros] = is_tiny_functor.tiny_cf_ntcf_id_is_tiny_ntcf'
subsectionβΉTiny natural isomorphismsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale is_tiny_iso_ntcf = is_iso_ntcf Ξ± π π
π π π + is_tiny_ntcf Ξ± π π
π π π
for Ξ± π π
π π π
syntax "_is_tiny_iso_ntcf" :: "V β V β V β V β V β V β bool"
(βΉ(_ : _ β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o _ : _ β¦β¦β©Cβ©.β©tβ©iβ©nβ©yΔ± _)βΊ [51, 51, 51, 51, 51] 51)
translations "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
" β
"CONST is_tiny_iso_ntcf Ξ± π π
π π π"
textβΉRules.βΊ
mk_ide rf is_tiny_iso_ntcf_def
|intro is_tiny_iso_ntcfI|
|dest is_tiny_iso_ntcfD[dest]|
|elim is_tiny_iso_ntcfE[elim]|
lemmas [ntcf_cs_intros] = is_tiny_iso_ntcfD(2)
textβΉElementary properties.βΊ
sublocale is_tiny_iso_ntcf β is_tm_iso_ntcf
by (rule is_tm_iso_ntcfI) (auto intro: cat_cs_intros cat_small_cs_intros)
lemmas (in is_tiny_iso_ntcf) is_tm_iso_ntcf_axioms' = is_tm_iso_ntcf_axioms
lemmas [ntcf_cs_intros] = is_tiny_iso_ntcf.is_tm_iso_ntcf_axioms'
textβΉFurther rules.βΊ
lemma is_tiny_iso_ntcfI':
assumes "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_iso_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_tiny_functor Ξ± π π
π by (rule assms(2))
interpret π: is_tiny_functor Ξ± π π
π by (rule assms(3))
show "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (intro is_tiny_iso_ntcfI is_tiny_ntcfI')
(auto intro: cat_cs_intros cat_small_cs_intros)
qed
lemma is_tiny_iso_ntcfD':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_tiny_iso_ntcf Ξ± π π
π π π by (rule assms(1))
show "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (auto intro: cat_cs_intros cat_small_cs_intros)
qed
lemma is_tiny_iso_ntcfE':
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
obtains "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
using assms by (auto dest: is_tiny_ntcfD'(2,3))
lemma is_tiny_iso_ntcf_iff:
"π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
β·
(
π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
β§
π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
β§
π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
)"
by (auto intro: is_tiny_iso_ntcfI' dest: is_tiny_ntcfD'(2,3))
subsubsectionβΉFurther propertiesβΊ
lemma iso_tiny_ntcf_is_arr_isomorphism:
assumes "category Ξ± π
" and "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
shows [ntcf_cs_intros]: "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π"
and "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
proof-
interpret π
: category Ξ± π
by (rule assms(1))
interpret π: is_tiny_iso_ntcf Ξ± π π
π π π by (rule assms)
note inv_π = iso_ntcf_is_arr_isomorphism[OF π.is_iso_ntcf_axioms]
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof(intro is_tiny_iso_ntcfI)
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
" by (intro inv_π(1))
interpret inv_π: is_iso_ntcf Ξ± π π
π π βΉinv_ntcf πβΊ by (rule inv_π(1))
show "inv_ntcf π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (intro is_tiny_ntcfI') (auto intro: cat_small_cs_intros cat_cs_intros)
qed
show "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id π" "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
by (intro inv_π(2,3))+
qed
lemma is_arr_isomorphism_is_tiny_iso_ntcf:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
and [simp]: "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
and [simp]: "π ββ©Nβ©Tβ©Cβ©F π = ntcf_id π"
shows "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©yβ©.β©iβ©sβ©o π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
proof-
interpret π: is_tiny_ntcf Ξ± π π
π π π by (rule assms(1))
interpret π: is_tiny_ntcf Ξ± π π
π π π by (rule assms(2))
show ?thesis
proof(rule is_tiny_iso_ntcfI)
show "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
by (rule is_arr_isomorphism_is_iso_ntcf) (auto intro: cat_small_cs_intros)
show "π : π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π : π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ±β π
"
by (rule is_tiny_ntcfI') (auto intro: cat_small_cs_intros)
qed
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_PCategory
sectionβΉProduct categoryβΊ
theory CZH_ECAT_PCategory
imports
CZH_ECAT_NTCF
CZH_ECAT_Small_Category
CZH_Foundations.CZH_SMC_PSemicategory
begin
subsectionβΉBackgroundβΊ
textβΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.βΊ
named_theorems cat_prod_cs_simps
named_theorems cat_prod_cs_intros
subsectionβΉProduct category: definition and elementary propertiesβΊ
definition cat_prod :: "V β (V β V) β V"
where "cat_prod I π =
[
(ββ©βiββ©βI. π iβ¦Objβ¦),
(ββ©βiββ©βI. π iβ¦Arrβ¦),
(Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). (Ξ»iββ©βI. π iβ¦Domβ¦β¦fβ¦iβ¦β¦)),
(Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). (Ξ»iββ©βI. π iβ¦Codβ¦β¦fβ¦iβ¦β¦)),
(
Ξ»gfββ©βcomposable_arrs (dg_prod I π).
(Ξ»iββ©βI. vpfst gfβ¦iβ¦ ββ©Aβπ iβ vpsnd gfβ¦iβ¦)
),
(Ξ»aββ©β(ββ©βiββ©βI. π iβ¦Objβ¦). (Ξ»iββ©βI. π iβ¦CIdβ¦β¦aβ¦iβ¦β¦))
]β©β"
syntax "_PCATEGORY" :: "pttrn β V β (V β V) β V"
("(3ββ©C_ββ©β_./ _)" [0, 0, 10] 10)
translations "ββ©Ciββ©βI. π" β "CONST cat_prod I (Ξ»i. π)"
textβΉComponents.βΊ
lemma cat_prod_components:
shows "(ββ©Ciββ©βI. π i)β¦Objβ¦ = (ββ©βiββ©βI. π iβ¦Objβ¦)"
and "(ββ©Ciββ©βI. π i)β¦Arrβ¦ = (ββ©βiββ©βI. π iβ¦Arrβ¦)"
and "(ββ©Ciββ©βI. π i)β¦Domβ¦ =
(Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). (Ξ»iββ©βI. π iβ¦Domβ¦β¦fβ¦iβ¦β¦))"
and "(ββ©Ciββ©βI. π i)β¦Codβ¦ =
(Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). (Ξ»iββ©βI. π iβ¦Codβ¦β¦fβ¦iβ¦β¦))"
and "(ββ©Ciββ©βI. π i)β¦Compβ¦ =
(
Ξ»gfββ©βcomposable_arrs (dg_prod I π).
(Ξ»iββ©βI. vpfst gfβ¦iβ¦ ββ©Aβπ iβ vpsnd gfβ¦iβ¦)
)"
and "(ββ©Ciββ©βI. π i)β¦CIdβ¦ =
(Ξ»aββ©β(ββ©βiββ©βI. π iβ¦Objβ¦). (Ξ»iββ©βI. π iβ¦CIdβ¦β¦aβ¦iβ¦β¦))"
unfolding cat_prod_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_cat_prod[slicing_commute]:
"smc_prod I (Ξ»i. cat_smc (π i)) = cat_smc (ββ©Ciββ©βI. π i)"
unfolding dg_prod_def cat_smc_def cat_prod_def smc_prod_def dg_field_simps
by (simp_all add: nat_omega_simps)
context
fixes π Ο :: "V β V"
and β :: V
begin
lemmas_with [
where π=βΉΞ»i. cat_smc (π i)βΊ, unfolded slicing_simps slicing_commute
]:
cat_prod_ObjI = smc_prod_ObjI
and cat_prod_ObjD = smc_prod_ObjD
and cat_prod_ObjE = smc_prod_ObjE
and cat_prod_Obj_cong = smc_prod_Obj_cong
and cat_prod_ArrI = smc_prod_ArrI
and cat_prod_ArrD = smc_prod_ArrD
and cat_prod_ArrE = smc_prod_ArrE
and cat_prod_Arr_cong = smc_prod_Arr_cong
and cat_prod_Dom_vsv[cat_cs_intros] = smc_prod_Dom_vsv
and cat_prod_Dom_vdomain[cat_cs_simps] = smc_prod_Dom_vdomain
and cat_prod_Dom_app = smc_prod_Dom_app
and cat_prod_Dom_app_component_app[cat_cs_simps] =
smc_prod_Dom_app_component_app
and cat_prod_Cod_vsv[cat_cs_intros] = smc_prod_Cod_vsv
and cat_prod_Cod_app = smc_prod_Cod_app
and cat_prod_Cod_vdomain[cat_cs_simps] = smc_prod_Cod_vdomain
and cat_prod_Cod_app_component_app[cat_cs_simps] =
smc_prod_Cod_app_component_app
and cat_prod_Comp = smc_prod_Comp
and cat_prod_Comp_vdomain[cat_cs_simps] = smc_prod_Comp_vdomain
and cat_prod_Comp_app = smc_prod_Comp_app
and cat_prod_Comp_app_component[cat_cs_simps] =
smc_prod_Comp_app_component
and cat_prod_Comp_app_vdomain = smc_prod_Comp_app_vdomain
and cat_prod_vunion_Obj_in_Obj = smc_prod_vunion_Obj_in_Obj
and cat_prod_vdiff_vunion_Obj_in_Obj = smc_prod_vdiff_vunion_Obj_in_Obj
and cat_prod_vunion_Arr_in_Arr = smc_prod_vunion_Arr_in_Arr
and cat_prod_vdiff_vunion_Arr_in_Arr = smc_prod_vdiff_vunion_Arr_in_Arr
end
subsectionβΉLocal assumptions for a product categoryβΊ
locale pcategory_base = π΅ Ξ± for Ξ± I π +
assumes pcat_categories: "i ββ©β I βΉ category Ξ± (π i)"
and pcat_index_in_Vset[cat_cs_intros]: "I ββ©β Vset Ξ±"
lemma (in pcategory_base) pcat_categories'[cat_prod_cs_intros]:
assumes "i ββ©β I" and "Ξ±' = Ξ±"
shows "category Ξ±' (π i)"
using assms(1) unfolding assms(2) by (rule pcat_categories)
textβΉRules.βΊ
lemma (in pcategory_base) pcategory_base_axioms'[cat_prod_cs_intros]:
assumes "Ξ±' = Ξ±" and "I' = I"
shows "pcategory_base Ξ±' I' π"
unfolding assms by (rule pcategory_base_axioms)
mk_ide rf pcategory_base_def[unfolded pcategory_base_axioms_def]
|intro pcategory_baseI|
|dest pcategory_baseD[dest]|
|elim pcategory_baseE[elim]|
lemma pcategory_base_psemicategory_baseI:
assumes "psemicategory_base Ξ± I (Ξ»i. cat_smc (π i))"
and "βi. i ββ©β I βΉ category Ξ± (π i)"
shows "pcategory_base Ξ± I π"
proof-
interpret psemicategory_base Ξ± I βΉΞ»i. cat_smc (π i)βΊ by (rule assms(1))
show ?thesis
by (intro pcategory_baseI)
(auto simp: assms(2) psmc_index_in_Vset psmc_Obj_in_Vset psmc_Arr_in_Vset)
qed
textβΉProduct category is a product semicategory.βΊ
context pcategory_base
begin
lemma pcat_psemicategory_base: "psemicategory_base Ξ± I (Ξ»i. cat_smc (π i))"
proof(intro psemicategory_baseI)
from pcat_index_in_Vset show "I ββ©β Vset Ξ±" by auto
qed (auto simp: category.cat_semicategory cat_prod_cs_intros)
interpretation psmc: psemicategory_base Ξ± I βΉΞ»i. cat_smc (π i)βΊ
by (rule pcat_psemicategory_base)
lemmas_with [unfolded slicing_simps slicing_commute]:
pcat_Obj_in_Vset = psmc.psmc_Obj_in_Vset
and pcat_Arr_in_Vset = psmc.psmc_Arr_in_Vset
and pcat_smc_prod_Obj_in_Vset = psmc.psmc_smc_prod_Obj_in_Vset
and pcat_smc_prod_Arr_in_Vset = psmc.psmc_smc_prod_Arr_in_Vset
and cat_prod_Dom_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Dom_app_in_Obj
and cat_prod_Cod_app_in_Obj[cat_cs_intros] = psmc.smc_prod_Cod_app_in_Obj
and cat_prod_is_arrI = psmc.smc_prod_is_arrI
and cat_prod_is_arrD[dest] = psmc.smc_prod_is_arrD
and cat_prod_is_arrE[elim] = psmc.smc_prod_is_arrE
end
lemma cat_prod_dg_prod_is_arr:
"g : b β¦βdg_prod I πβ c β· g : b β¦β(ββ©Ciββ©βI. π i)β c"
unfolding is_arr_def cat_prod_def smc_prod_def dg_prod_def dg_field_simps
by (simp add: nat_omega_simps)
lemma smc_prod_composable_arrs_dg_prod:
"composable_arrs (dg_prod I π) = composable_arrs (ββ©Ciββ©βI. π i)"
unfolding composable_arrs_def cat_prod_dg_prod_is_arr by simp
textβΉElementary properties.βΊ
lemma (in pcategory_base) pcat_vsubset_index_pcategory_base:
assumes "J ββ©β I"
shows "pcategory_base Ξ± J π"
proof(intro pcategory_baseI)
show "category Ξ± (π i)" if "i ββ©β J" for i
using that assms by (auto intro: cat_prod_cs_intros)
from assms show "J ββ©β Vset Ξ±" by (simp add: vsubset_in_VsetI cat_cs_intros)
qed auto
subsubsectionβΉIdentityβΊ
lemma cat_prod_CId_vsv[cat_cs_intros]: "vsv ((ββ©Ciββ©βI. π i)β¦CIdβ¦)"
unfolding cat_prod_components by auto
lemma cat_prod_CId_vdomain[cat_cs_simps]:
"πβ©β ((ββ©Ciββ©βI. π i)β¦CIdβ¦) = (ββ©Ciββ©βI. π i)β¦Objβ¦"
unfolding cat_prod_components by simp
lemma cat_prod_CId_app:
assumes "a ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦"
shows "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦aβ¦ = (Ξ»iββ©βI. π iβ¦CIdβ¦β¦aβ¦iβ¦β¦)"
using assms unfolding cat_prod_components by simp
lemma cat_prod_CId_app_component[cat_cs_simps]:
assumes "a ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦" and "i ββ©β I"
shows "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦aβ¦β¦iβ¦ = π iβ¦CIdβ¦β¦aβ¦iβ¦β¦"
using assms unfolding cat_prod_components by simp
lemma (in pcategory_base) cat_prod_CId_vrange:
"ββ©β ((ββ©Ciββ©βI. π i)β¦CIdβ¦) ββ©β (ββ©βiββ©βI. π iβ¦Arrβ¦)"
proof(intro vsubsetI)
interpret CId: vsv βΉ((ββ©Ciββ©βI. π i)β¦CIdβ¦)βΊ by (rule cat_prod_CId_vsv)
fix f assume "f ββ©β ββ©β ((ββ©Ciββ©βI. π i)β¦CIdβ¦)"
then obtain a where f_def: "f = ((ββ©Ciββ©βI. π i)β¦CIdβ¦)β¦aβ¦"
and "a ββ©β πβ©β ((ββ©Ciββ©βI. π i)β¦CIdβ¦)"
by (blast dest: CId.vrange_atD)
then have a: "a ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦"
unfolding cat_prod_components by simp
show "f ββ©β (ββ©βiββ©βI. π iβ¦Arrβ¦)"
unfolding f_def cat_prod_CId_app[OF a]
proof(rule VLambda_in_vproduct)
fix i assume prems: "i ββ©β I"
interpret π: category Ξ± βΉπ iβΊ
by (simp add: βΉi ββ©β IβΊ cat_cs_intros cat_prod_cs_intros)
from prems a have "aβ¦iβ¦ ββ©β π iβ¦Objβ¦" unfolding cat_prod_components by auto
with is_arrD(1) show "π iβ¦CIdβ¦β¦aβ¦iβ¦β¦ ββ©β π iβ¦Arrβ¦"
by (auto intro: cat_cs_intros)
qed
qed
subsubsectionβΉA product βΉΞ±βΊ-category is a tiny βΉΞ²βΊ-categoryβΊ
lemma (in pcategory_base) pcat_tiny_category_cat_prod:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² (ββ©Ciββ©βI. π i)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show ?thesis
proof(intro tiny_categoryI, (unfold slicing_simps)?)
show Ξ : "tiny_semicategory Ξ² (cat_smc (ββ©Ciββ©βI. π i))"
unfolding slicing_commute[symmetric]
by
(
intro psemicategory_base.psmc_tiny_semicategory_smc_prod;
(rule assms pcat_psemicategory_base)?
)
interpret Ξ : tiny_semicategory Ξ² βΉcat_smc (ββ©Ciββ©βI. π i)βΊ by (rule Ξ )
show "vfsequence (ββ©Ciββ©βI. π i)" unfolding cat_prod_def by auto
show "vcard (ββ©Ciββ©βI. π i) = 6β©β"
unfolding cat_prod_def by (simp add: nat_omega_simps)
show CId: "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦aβ¦ : a β¦β(ββ©Ciββ©βI. π i)β a"
if a: "a ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦" for a
proof(rule cat_prod_is_arrI)
have [cat_cs_intros]: "aβ¦iβ¦ ββ©β π iβ¦Objβ¦" if i: "i ββ©β I" for i
by (rule cat_prod_ObjD(3)[OF a i])
from that show "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦aβ¦β¦iβ¦ : aβ¦iβ¦ β¦βπ iβ aβ¦iβ¦"
if "i ββ©β I" for i
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros that
)
qed (use that in βΉauto simp: cat_prod_components cat_prod_CId_app thatβΊ)
show "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ ββ©Aβ(ββ©Ciββ©βI. π i)β f = f"
if "f : a β¦β(ββ©Ciββ©βI. π i)β b" for f a b
proof(rule cat_prod_Arr_cong)
note f = Ξ .smc_is_arrD[unfolded slicing_simps, OF that]
note a = f(2) and b = f(3) and f = f(1)
from CId[OF b] have CId_b:
"(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ : b β¦β(ββ©Ciββ©βI. π i)β b"
by simp
from Ξ .smc_Comp_is_arr[unfolded slicing_simps, OF this that] show
"(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ ββ©Aβ(ββ©Ciββ©βI. π i)β f ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
by (simp add: cat_cs_intros)
from that show "f ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦" by auto
fix i assume prems: "i ββ©β I"
interpret πi: category Ξ± βΉπ iβΊ by (simp add: prems cat_prod_cs_intros)
from prems cat_prod_is_arrD(7)[OF that] have fi:
"fβ¦iβ¦ : aβ¦iβ¦ β¦βπ iβ bβ¦iβ¦"
by auto
from prems show "((ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ ββ©Aβ(ββ©Ciββ©βI. π i)β f)β¦iβ¦ = fβ¦iβ¦"
unfolding cat_prod_Comp_app_component[OF CId_b that prems]
unfolding cat_prod_CId_app[OF b]
by (auto intro: πi.cat_CId_left_left[OF fi])
qed
show "f ββ©Aβ(ββ©Ciββ©βI. π i)β (ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ = f"
if "f : b β¦β(ββ©Ciββ©βI. π i)β c" for f b c
proof(rule cat_prod_Arr_cong)
note f = Ξ .smc_is_arrD[unfolded slicing_simps, OF that]
note b = f(2) and c = f(3) and f = f(1)
from CId[OF b] have CId_b:
"(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ : b β¦β(ββ©Ciββ©βI. π i)β b"
by simp
from Ξ .smc_Comp_is_arr[unfolded slicing_simps, OF that this] show
"f ββ©Aβ(ββ©Ciββ©βI. π i)β (ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦ ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
by (simp add: cat_cs_intros)
from that show "f ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦" by auto
fix i assume prems: "i ββ©β I"
interpret πi: category Ξ± βΉπ iβΊ by (simp add: prems cat_prod_cs_intros)
from prems cat_prod_is_arrD[OF that] have fi: "fβ¦iβ¦ : bβ¦iβ¦ β¦βπ iβ cβ¦iβ¦"
by simp
from prems show "(f ββ©Aβ(ββ©Ciββ©βI. π i)β (ββ©Ciββ©βI. π i)β¦CIdβ¦β¦bβ¦)β¦iβ¦ = fβ¦iβ¦"
unfolding cat_prod_Comp_app_component[OF that CId_b prems]
unfolding cat_prod_CId_app[OF b]
by (auto intro: πi.cat_CId_right_left[OF fi])
qed
qed (auto simp: cat_cs_intros cat_cs_simps intro: cat_cs_intros)
qed
subsectionβΉFurther local assumptions for product categoriesβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale pcategory = pcategory_base Ξ± I π for Ξ± I π +
assumes pcat_Obj_vsubset_Vset: "J ββ©β I βΉ (ββ©Ciββ©βJ. π i)β¦Objβ¦ ββ©β Vset Ξ±"
and pcat_Hom_vifunion_in_Vset:
"β¦
J ββ©β I;
A ββ©β (ββ©Ciββ©βJ. π i)β¦Objβ¦;
B ββ©β (ββ©Ciββ©βJ. π i)β¦Objβ¦;
A ββ©β Vset Ξ±;
B ββ©β Vset Ξ±
β§ βΉ (ββ©βaββ©βA. ββ©βbββ©βB. Hom (ββ©Ciββ©βJ. π i) a b) ββ©β Vset Ξ±"
textβΉRules.βΊ
lemma (in pcategory) pcategory_axioms'[cat_prod_cs_intros]:
assumes "Ξ±' = Ξ±" and "I' = I"
shows "pcategory Ξ±' I' π"
unfolding assms by (rule pcategory_axioms)
mk_ide rf pcategory_def[unfolded pcategory_axioms_def]
|intro pcategoryI|
|dest pcategoryD[dest]|
|elim pcategoryE[elim]|
lemmas [cat_prod_cs_intros] = pcategoryD(1)
lemma pcategory_psemicategoryI:
assumes "psemicategory Ξ± I (Ξ»i. cat_smc (π i))"
and "βi. i ββ©β I βΉ category Ξ± (π i)"
shows "pcategory Ξ± I π"
proof-
interpret psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ by (rule assms(1))
note [unfolded slicing_simps slicing_commute, cat_cs_intros] =
psmc_Obj_vsubset_Vset
psmc_Hom_vifunion_in_Vset
show ?thesis
by (intro pcategoryI pcategory_base_psemicategory_baseI)
(auto simp: assms(2) smc_prod_cs_intros intro!: cat_cs_intros)
qed
textβΉProduct category is a product semicategory.βΊ
context pcategory
begin
lemma pcat_psemicategory: "psemicategory Ξ± I (Ξ»i. cat_smc (π i))"
proof(intro psemicategoryI, unfold slicing_simps slicing_commute)
show "psemicategory_base Ξ± I (Ξ»i. cat_smc (π i))"
by (rule pcat_psemicategory_base)
qed (auto intro!: pcat_Obj_vsubset_Vset pcat_Hom_vifunion_in_Vset)
interpretation psmc: psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ
by (rule pcat_psemicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
pcat_Obj_vsubset_Vset' = psmc.psmc_Obj_vsubset_Vset'
and pcat_Hom_vifunion_in_Vset' = psmc.psmc_Hom_vifunion_in_Vset'
and pcat_cat_prod_vunion_is_arr = psmc.psmc_smc_prod_vunion_is_arr
and pcat_cat_prod_vdiff_vunion_is_arr = psmc.psmc_smc_prod_vdiff_vunion_is_arr
lemmas_with [unfolded slicing_simps slicing_commute]:
pcat_cat_prod_vunion_Comp = psmc.psmc_smc_prod_vunion_Comp
and pcat_cat_prod_vdiff_vunion_Comp = psmc.psmc_smc_prod_vdiff_vunion_Comp
end
textβΉElementary properties.βΊ
lemma (in pcategory) pcat_vsubset_index_pcategory:
assumes "J ββ©β I"
shows "pcategory Ξ± J π"
proof(intro pcategoryI pcategory_psemicategoryI)
show "cat_prod J' πβ¦Objβ¦ ββ©β Vset Ξ±" if βΉJ' ββ©β JβΊ for J'
proof-
from that assms have "J' ββ©β I" by simp
then show "cat_prod J' πβ¦Objβ¦ ββ©β Vset Ξ±" by (rule pcat_Obj_vsubset_Vset)
qed
fix A B J' assume prems:
"J' ββ©β J"
"A ββ©β (ββ©Ciββ©βJ'. π i)β¦Objβ¦"
"B ββ©β (ββ©Ciββ©βJ'. π i)β¦Objβ¦"
"A ββ©β Vset Ξ±"
"B ββ©β Vset Ξ±"
show "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (ββ©Ciββ©βJ'. π i) a b) ββ©β Vset Ξ±"
proof-
from prems(1) assms have "J' ββ©β I" by simp
from pcat_Hom_vifunion_in_Vset[OF this prems(2-5)] show ?thesis.
qed
qed (rule pcat_vsubset_index_pcategory_base[OF assms])
subsubsectionβΉA product βΉΞ±βΊ-category is an βΉΞ±βΊ-categoryβΊ
lemma (in pcategory) pcat_category_cat_prod: "category Ξ± (ββ©Ciββ©βI. π i)"
proof-
interpret tiny_category βΉΞ± + ΟβΊ βΉββ©Ciββ©βI. π iβΊ
by (intro pcat_tiny_category_cat_prod)
(auto simp: π΅_Ξ±_Ξ±Ο π΅.intro π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο)
show ?thesis
by (rule category_if_category)
(
auto
intro!: pcat_Hom_vifunion_in_Vset pcat_Obj_vsubset_Vset
intro: cat_cs_intros
)
qed
subsectionβΉLocal assumptions for a finite product categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale finite_pcategory = pcategory_base Ξ± I π for Ξ± I π +
assumes fin_pcat_index_vfinite: "vfinite I"
textβΉRules.βΊ
lemma (in finite_pcategory) finite_pcategory_axioms[cat_prod_cs_intros]:
assumes "Ξ±' = Ξ±" and "I' = I"
shows "finite_pcategory Ξ±' I' π"
unfolding assms by (rule finite_pcategory_axioms)
mk_ide rf finite_pcategory_def[unfolded finite_pcategory_axioms_def]
|intro finite_pcategoryI|
|dest finite_pcategoryD[dest]|
|elim finite_pcategoryE[elim]|
lemmas [cat_prod_cs_intros] = finite_pcategoryD(1)
lemma finite_pcategory_finite_psemicategoryI:
assumes "finite_psemicategory Ξ± I (Ξ»i. cat_smc (π i))"
and "βi. i ββ©β I βΉ category Ξ± (π i)"
shows "finite_pcategory Ξ± I π"
proof-
interpret finite_psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ by (rule assms(1))
show ?thesis
by
(
intro
assms
finite_pcategoryI
pcategory_base_psemicategory_baseI
finite_psemicategoryD(1)[OF assms(1)]
fin_psmc_index_vfinite
)
qed
subsubsectionβΉ
Local assumptions for a finite product semicategory and local
assumptions for an arbitrary product semicategory
βΊ
sublocale finite_pcategory β pcategory Ξ± I π
proof-
interpret finite_psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ
proof(intro finite_psemicategoryI psemicategory_baseI)
fix i assume "i ββ©β I"
then interpret πi: category Ξ± βΉπ iβΊ by (simp add: pcat_categories)
show "semicategory Ξ± (cat_smc (π i))" by (simp add: πi.cat_semicategory)
qed (auto intro!: cat_cs_intros fin_pcat_index_vfinite)
show "pcategory Ξ± I π"
by (intro pcategory_psemicategoryI)
(simp_all add: pcat_categories psemicategory_axioms)
qed
subsectionβΉBinary union and complementβΊ
lemma (in pcategory) pcat_cat_prod_vunion_CId:
assumes "vdisjnt J K"
and "J ββ©β I"
and "K ββ©β I"
and "a ββ©β (ββ©Cjββ©βJ. π j)β¦Objβ¦"
and "b ββ©β (ββ©Cjββ©βK. π j)β¦Objβ¦"
shows
"(ββ©Cjββ©βJ. π j)β¦CIdβ¦β¦aβ¦ βͺβ©β (ββ©Cjββ©βK. π j)β¦CIdβ¦β¦bβ¦ =
(ββ©Ciββ©βJ βͺβ©β K. π i)β¦CIdβ¦β¦a βͺβ©β bβ¦"
proof-
interpret Jπ: pcategory Ξ± J π
using assms(2) by (simp add: pcat_vsubset_index_pcategory)
interpret Kπ: pcategory Ξ± K π
using assms(3) by (simp add: pcat_vsubset_index_pcategory)
interpret JKπ: pcategory Ξ± βΉJ βͺβ©β KβΊ π
using assms(2,3) by (simp add: pcat_vsubset_index_pcategory)
interpret Jπ': category Ξ± βΉcat_prod J πβΊ
by (rule Jπ.pcat_category_cat_prod)
interpret Kπ': category Ξ± βΉcat_prod K πβΊ
by (rule Kπ.pcat_category_cat_prod)
interpret JKπ': category Ξ± βΉcat_prod (J βͺβ©β K) πβΊ
by (rule JKπ.pcat_category_cat_prod)
from assms(4) have CId_a: "cat_prod J πβ¦CIdβ¦β¦aβ¦ : a β¦β(ββ©Cjββ©βJ. π j)β a"
by (auto intro: cat_cs_intros)
from assms(5) have CId_b: "cat_prod K πβ¦CIdβ¦β¦bβ¦ : b β¦β(ββ©Ckββ©βK. π k)β b"
by (auto intro: cat_cs_intros)
have CId_a_CId_b: "cat_prod J πβ¦CIdβ¦β¦aβ¦ βͺβ©β cat_prod K πβ¦CIdβ¦β¦bβ¦ :
a βͺβ©β b β¦βcat_prod (J βͺβ©β K) πβ a βͺβ©β b"
by (rule pcat_cat_prod_vunion_is_arr[OF assms(1-3) CId_a CId_b])
from CId_a have a: "a ββ©β cat_prod J πβ¦Objβ¦" by (auto intro: cat_cs_intros)
from CId_b have b: "b ββ©β cat_prod K πβ¦Objβ¦" by (auto intro: cat_cs_intros)
from CId_a_CId_b have ab: "a βͺβ©β b ββ©β cat_prod (J βͺβ©β K) πβ¦Objβ¦"
by (auto intro: cat_cs_intros)
note CId_aD = Jπ.cat_prod_is_arrD[OF CId_a]
and CId_bD = Kπ.cat_prod_is_arrD[OF CId_b]
show ?thesis
proof(rule cat_prod_Arr_cong[of _ βΉJ βͺβ©β KβΊ π])
from CId_a_CId_b show
"cat_prod J πβ¦CIdβ¦β¦aβ¦ βͺβ©β cat_prod K πβ¦CIdβ¦β¦bβ¦ ββ©β cat_prod (J βͺβ©β K) πβ¦Arrβ¦"
by auto
from ab show "cat_prod (J βͺβ©β K) πβ¦CIdβ¦β¦a βͺβ©β bβ¦ ββ©β cat_prod (J βͺβ©β K) πβ¦Arrβ¦"
by (auto intro: JKπ'.cat_is_arrD(1) cat_cs_intros)
fix i assume "i ββ©β J βͺβ©β K"
then consider (iJ) βΉi ββ©β JβΊ | (iK) βΉi ββ©β KβΊ by auto
then show "(cat_prod J πβ¦CIdβ¦β¦aβ¦ βͺβ©β cat_prod K πβ¦CIdβ¦β¦bβ¦)β¦iβ¦ =
cat_prod (J βͺβ©β K) πβ¦CIdβ¦β¦a βͺβ©β bβ¦β¦iβ¦"
by cases
(
auto simp:
assms(1)
CId_aD(1-4)
CId_bD(1-4)
cat_prod_CId_app[OF ab]
cat_prod_CId_app[OF a]
cat_prod_CId_app[OF b]
)
qed
qed
lemma (in pcategory) pcat_cat_prod_vdiff_vunion_CId:
assumes "J ββ©β I"
and "a ββ©β (ββ©Cjββ©βI -β©β J. π j)β¦Objβ¦"
and "b ββ©β (ββ©Cjββ©βJ. π j)β¦Objβ¦"
shows
"(ββ©Cjββ©βI -β©β J. π j)β¦CIdβ¦β¦aβ¦ βͺβ©β (ββ©Cjββ©βJ. π j)β¦CIdβ¦β¦bβ¦ =
(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦a βͺβ©β bβ¦"
by
(
vdiff_of_vunion'
rule: pcat_cat_prod_vunion_CId assms: assms(2-3) subset: assms(1)
)
subsectionβΉProjectionβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.βΊ
definition cf_proj :: "V β (V β V) β V β V" (βΉΟβ©CβΊ)
where "Οβ©C I π i =
[
(Ξ»aββ©β(ββ©βiββ©βI. π iβ¦Objβ¦). aβ¦iβ¦),
(Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). fβ¦iβ¦),
(ββ©Ciββ©βI. π i),
π i
]β©β"
textβΉComponents.βΊ
lemma cf_proj_components:
shows "Οβ©C I π iβ¦ObjMapβ¦ = (Ξ»aββ©β(ββ©βiββ©βI. π iβ¦Objβ¦). aβ¦iβ¦)"
and "Οβ©C I π iβ¦ArrMapβ¦ = (Ξ»fββ©β(ββ©βiββ©βI. π iβ¦Arrβ¦). fβ¦iβ¦)"
and "Οβ©C I π iβ¦HomDomβ¦ = (ββ©Ciββ©βI. π i)"
and "Οβ©C I π iβ¦HomCodβ¦ = π i"
unfolding cf_proj_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicingβΊ
lemma cf_smcf_cf_proj[slicing_commute]:
"Οβ©Sβ©Mβ©C I (Ξ»i. cat_smc (π i)) i = cf_smcf (Οβ©C I π i)"
unfolding
cat_smc_def
cf_smcf_def
smcf_proj_def
cf_proj_def
cat_prod_def
smc_prod_def
dg_prod_def
dg_field_simps
dghm_field_simps
by (simp add: nat_omega_simps)
context pcategory
begin
interpretation psmc: psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ
by (rule pcat_psemicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
pcat_cf_proj_is_semifunctor = psmc.psmc_smcf_proj_is_semifunctor
end
subsubsectionβΉProjection functor is a functorβΊ
lemma (in pcategory) pcat_cf_proj_is_functor:
assumes "i ββ©β I"
shows "Οβ©C I π i : (ββ©Ciββ©βI. π i) β¦β¦β©CβΞ±β π i"
proof(intro is_functorI)
interpret π: category Ξ± βΉ(ββ©Ciββ©βI. π i)βΊ
by (simp add: pcat_category_cat_prod)
show "vfsequence (Οβ©C I π i)" unfolding cf_proj_def by simp
show "category Ξ± (ββ©Ciββ©βI. π i)" by (simp add: π.category_axioms)
show "vcard (Οβ©C I π i) = 4β©β"
unfolding cf_proj_def by (simp add: nat_omega_simps)
show "Οβ©C I π iβ¦ArrMapβ¦β¦(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦β¦ = π iβ¦CIdβ¦β¦Οβ©C I π iβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦" for c
proof-
interpret πi: category Ξ± βΉπ iβΊ
by (auto intro: assms cat_prod_cs_intros)
from that have "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦ : c β¦β(ββ©Ciββ©βI. π i)β c"
by (simp add: π.cat_CId_is_arr)
then have "(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦ ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
by (auto intro: cat_cs_intros)
with assms have
"Οβ©C I π iβ¦ArrMapβ¦β¦(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦β¦ = (ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦β¦iβ¦"
unfolding cf_proj_components cat_prod_components by simp
also from assms have "β¦ = π iβ¦CIdβ¦β¦cβ¦iβ¦β¦"
unfolding cat_prod_CId_app[OF that] by simp
also from that have "β¦ = π iβ¦CIdβ¦β¦Οβ©C I π iβ¦ObjMapβ¦β¦cβ¦β¦"
unfolding cf_proj_components cat_prod_components by simp
finally show
"Οβ©C I π iβ¦ArrMapβ¦β¦(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cβ¦β¦ = π iβ¦CIdβ¦β¦Οβ©C I π iβ¦ObjMapβ¦β¦cβ¦β¦"
by simp
qed
qed
(
auto simp:
assms cf_proj_components pcat_cf_proj_is_semifunctor cat_prod_cs_intros
)
lemma (in pcategory) pcat_cf_proj_is_functor':
assumes "i ββ©β I" and "β = (ββ©Ciββ©βI. π i)" and "π = π i"
shows "Οβ©C I π i : β β¦β¦β©CβΞ±β π"
using assms(1) unfolding assms(2,3) by (rule pcat_cf_proj_is_functor)
lemmas [cat_cs_intros] = pcategory.pcat_cf_proj_is_functor'
subsectionβΉCategory product universal property functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The functor that is presented in this section is used in the proof of
the universal property of the product category later in this work.
βΊ
definition cf_up :: "V β (V β V) β V β (V β V) β V"
where "cf_up I π β Ο =
[
(Ξ»aββ©βββ¦Objβ¦. (Ξ»iββ©βI. Ο iβ¦ObjMapβ¦β¦aβ¦)),
(Ξ»fββ©βββ¦Arrβ¦. (Ξ»iββ©βI. Ο iβ¦ArrMapβ¦β¦fβ¦)),
β,
(ββ©Ciββ©βI. π i)
]β©β"
textβΉComponents.βΊ
lemma cf_up_components:
shows "cf_up I π β Οβ¦ObjMapβ¦ = (Ξ»aββ©βββ¦Objβ¦. (Ξ»iββ©βI. Ο iβ¦ObjMapβ¦β¦aβ¦))"
and "cf_up I π β Οβ¦ArrMapβ¦ = (Ξ»fββ©βββ¦Arrβ¦. (Ξ»iββ©βI. Ο iβ¦ArrMapβ¦β¦fβ¦))"
and "cf_up I π β Οβ¦HomDomβ¦ = β"
and "cf_up I π β Οβ¦HomCodβ¦ = (ββ©Ciββ©βI. π i)"
unfolding cf_up_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smcf_dghm_cf_up[slicing_commute]:
"smcf_up I (Ξ»i. cat_smc (π i)) (cat_smc β) (Ξ»i. cf_smcf (Ο i)) =
cf_smcf (cf_up I π β Ο)"
unfolding
cat_smc_def
cf_smcf_def
cf_up_def
smcf_up_def
cat_prod_def
smc_prod_def
dg_prod_def
dg_field_simps
dghm_field_simps
by (simp add: nat_omega_simps)
context
fixes π Ο :: "V β V"
and β :: V
begin
lemmas_with
[
where π=βΉΞ»i. cat_smc (π i)βΊ and Ο=βΉΞ»i. cf_smcf (Ο i)βΊ and β = βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute
]:
cf_up_ObjMap_vdomain[simp] = smcf_up_ObjMap_vdomain
and cf_up_ObjMap_app = smcf_up_ObjMap_app
and cf_up_ObjMap_app_vdomain[simp] = smcf_up_ObjMap_app_vdomain
and cf_up_ObjMap_app_component = smcf_up_ObjMap_app_component
and cf_up_ArrMap_vdomain[simp] = smcf_up_ArrMap_vdomain
and cf_up_ArrMap_app = smcf_up_ArrMap_app
and cf_up_ArrMap_app_vdomain[simp] = smcf_up_ArrMap_app_vdomain
and cf_up_ArrMap_app_component = smcf_up_ArrMap_app_component
lemma cf_up_ObjMap_vrange:
assumes "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
shows "ββ©β (cf_up I π β Οβ¦ObjMapβ¦) ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦"
proof
(
rule smcf_up_ObjMap_vrange[
where π=βΉΞ»i. cat_smc (π i)βΊ
and Ο=βΉΞ»i. cf_smcf (Ο i)βΊ
and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute
]
)
fix i assume "i ββ©β I"
then interpret is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (rule assms)
show "cf_smcf (Ο i) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (π i)"
by (rule cf_is_semifunctor)
qed
lemma cf_up_ObjMap_app_vrange:
assumes "a ββ©β ββ¦Objβ¦" and "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
shows " ββ©β (cf_up I π β Οβ¦ObjMapβ¦β¦aβ¦) ββ©β (ββ©βiββ©βI. π iβ¦Objβ¦)"
proof
(
rule smcf_up_ObjMap_app_vrange[
where π=βΉΞ»i. cat_smc (π i)βΊ
and Ο=βΉΞ»i. cf_smcf (Ο i)βΊ
and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute
]
)
show "a ββ©β ββ¦Objβ¦" by (rule assms)
fix i assume "i ββ©β I"
then interpret is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (rule assms(2))
show "cf_smcf (Ο i) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (π i)"
by (rule cf_is_semifunctor)
qed
lemma cf_up_ArrMap_vrange:
assumes "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
shows "ββ©β (cf_up I π β Οβ¦ArrMapβ¦) ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
proof
(
rule smcf_up_ArrMap_vrange[
where π=βΉΞ»i. cat_smc (π i)βΊ
and Ο=βΉΞ»i. cf_smcf (Ο i)βΊ
and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute
]
)
fix i assume "i ββ©β I"
then interpret is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (rule assms)
show "cf_smcf (Ο i) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (π i)"
by (rule cf_is_semifunctor)
qed
lemma cf_up_ArrMap_app_vrange:
assumes "a ββ©β ββ¦Arrβ¦" and "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
shows " ββ©β (cf_up I π β Οβ¦ArrMapβ¦β¦aβ¦) ββ©β (ββ©βiββ©βI. π iβ¦Arrβ¦)"
proof
(
rule smcf_up_ArrMap_app_vrange
[
where π=βΉΞ»i. cat_smc (π i)βΊ
and Ο=βΉΞ»i. cf_smcf (Ο i)βΊ
and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute
]
)
fix i assume "i ββ©β I"
then interpret is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (rule assms(2))
show "cf_smcf (Ο i) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (π i)"
by (rule cf_is_semifunctor)
qed (rule assms)
end
context pcategory
begin
interpretation psmc: psemicategory Ξ± I βΉΞ»i. cat_smc (π i)βΊ
by (rule pcat_psemicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
pcat_smcf_comp_smcf_proj_smcf_up = psmc.psmc_Comp_smcf_proj_smcf_up
and pcat_smcf_up_eq_smcf_proj = psmc.psmc_smcf_up_eq_smcf_proj
end
subsubsectionβΉCategory product universal property functor is a functorβΊ
lemma (in pcategory) pcat_cf_up_is_functor:
assumes "category Ξ± β" and "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
shows "cf_up I π β Ο : β β¦β¦β©CβΞ±β (ββ©Ciββ©βI. π i)"
proof-
interpret β: category Ξ± β by (simp add: assms(1))
interpret π: category Ξ± βΉ(ββ©Ciββ©βI. π i)βΊ by (rule pcat_category_cat_prod)
show ?thesis
proof(intro is_functorI)
show "vfsequence (cf_up I π β Ο)" unfolding cf_up_def by simp
show "vcard (cf_up I π β Ο) = 4β©β"
unfolding cf_up_def by (simp add: nat_omega_simps)
show "cf_smcf (cf_up I π β Ο) : cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (ββ©Ciββ©βI. π i)"
unfolding slicing_commute[symmetric]
by (rule psemicategory.psmc_smcf_up_is_semifunctor)
(
auto simp:
assms(2)
pcat_psemicategory
is_functor.cf_is_semifunctor
slicing_intros
)
show "cf_up I π β Οβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ =
(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cf_up I π β Οβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β ββ¦Objβ¦" for c
proof(rule cat_prod_Arr_cong)
from that is_arrD(1) have CId_c: "ββ¦CIdβ¦β¦cβ¦ ββ©β ββ¦Arrβ¦"
by (auto intro: cat_cs_intros)
from CId_c cf_up_ArrMap_vrange[OF assms(2), simplified]
show "cf_up I π β Οβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
unfolding cf_up_components by force
have cf_up_Ο_c: "cf_up I π β Οβ¦ObjMapβ¦β¦cβ¦ ββ©β (ββ©Ciββ©βI. π i)β¦Objβ¦"
unfolding cat_prod_components
proof(intro vproductI ballI)
fix i assume prems: "i ββ©β I"
interpret Ο: is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (simp add: prems assms(2))
from that show "cf_up I π β Οβ¦ObjMapβ¦β¦cβ¦β¦iβ¦ ββ©β π iβ¦Objβ¦"
unfolding cf_up_ObjMap_app_component[OF that prems]
by (auto intro: cat_cs_intros)
qed (simp_all add: cf_up_ObjMap_app that cf_up_ObjMap_app[OF that])
from π.cat_CId_is_arr[OF this] show
"(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cf_up I π β Οβ¦ObjMapβ¦β¦cβ¦β¦ ββ©β (ββ©Ciββ©βI. π i)β¦Arrβ¦"
by auto
fix i assume prems: "i ββ©β I"
interpret Ο: is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (simp add: prems assms(2))
from cf_up_Ο_c prems show
"cf_up I π β Οβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦β¦iβ¦ =
(ββ©Ciββ©βI. π i)β¦CIdβ¦β¦cf_up I π β Οβ¦ObjMapβ¦β¦cβ¦β¦β¦iβ¦"
unfolding cf_up_ArrMap_app_component[OF CId_c prems] cat_prod_components
by
(
simp add:
that cf_up_ObjMap_app_component[OF that prems] Ο.cf_ObjMap_CId
)
qed
qed (auto simp: cf_up_components cat_cs_intros)
qed
subsubsectionβΉFurther propertiesβΊ
lemma (in pcategory) pcat_Comp_cf_proj_cf_up:
assumes "category Ξ± β"
and "βi. i ββ©β I βΉ Ο i : β β¦β¦β©CβΞ±β π i"
and "i ββ©β I"
shows "Ο i = Οβ©C I π i ββ©Cβ©F (cf_up I π β Ο)"
proof-
interpret Ο: is_functor Ξ± β βΉπ iβΊ βΉΟ iβΊ by (rule assms(2)[OF assms(3)])
interpret Ο: is_functor Ξ± βΉ(ββ©Ciββ©βI. π i)βΊ βΉπ iβΊ βΉΟβ©C I π iβΊ
by (simp add: assms(3) pcat_cf_proj_is_functor)
interpret up: is_functor Ξ± β βΉ(ββ©Ciββ©βI. π i)βΊ βΉcf_up I π β ΟβΊ
by (simp add: assms(2) Ο.HomDom.category_axioms pcat_cf_up_is_functor)
show ?thesis
proof(rule cf_smcf_eqI)
show "Οβ©C I π i ββ©Cβ©F cf_up I π β Ο : β β¦β¦β©CβΞ±β π i"
by (auto intro: cat_cs_intros)
from assms show "cf_smcf (Ο i) = cf_smcf (Οβ©C I π i ββ©Cβ©F cf_up I π β Ο)"
unfolding slicing_simps slicing_commute[symmetric]
by
(
intro pcat_smcf_comp_smcf_proj_smcf_up[
where Ο=βΉΞ»i. cf_smcf (Ο i)βΊ, unfolded slicing_commute[symmetric]
]
)
(auto simp: is_functor.cf_is_semifunctor)
qed (auto intro: cat_cs_intros)
qed
lemma (in pcategory) pcat_cf_up_eq_cf_proj:
assumes "π : β β¦β¦β©CβΞ±β (ββ©Ciββ©βI. π i)"
and "βi. i ββ©β I βΉ Ο i = Οβ©C I π i ββ©Cβ©F π"
shows "cf_up I π β Ο = π"
proof(rule cf_smcf_eqI)
interpret π: is_functor Ξ± β βΉ(ββ©Ciββ©βI. π i)βΊ π by (rule assms(1))
show "cf_up I π β Ο : β β¦β¦β©CβΞ±β (ββ©Ciββ©βI. π i)"
proof(rule pcat_cf_up_is_functor)
fix i assume prems: "i ββ©β I"
then interpret Ο: is_functor Ξ± βΉ(ββ©Ciββ©βI. π i)βΊ βΉπ iβΊ βΉΟβ©C I π iβΊ
by (rule pcat_cf_proj_is_functor)
show "Ο i : β β¦β¦β©CβΞ±β π i"
unfolding assms(2)[OF prems] by (auto intro: cat_cs_intros)
qed (auto intro: cat_cs_intros)
show "π : β β¦β¦β©CβΞ±β (ββ©Ciββ©βI. π i)" by (rule assms(1))
from assms show "cf_smcf (cf_up I π β Ο) = cf_smcf π"
unfolding slicing_commute[symmetric]
by (intro pcat_smcf_up_eq_smcf_proj) (auto simp: slicing_commute)
qed simp_all
subsectionβΉProdfunctor with respect to a fixed argumentβΊ
textβΉ
A prodfunctor is a functor whose domain is a product category.
It is a generalization of the concept of the bifunctor,
as presented in Chapter II-3 in \cite{mac_lane_categories_2010}.
βΊ
definition prodfunctor_proj :: "V β V β (V β V) β V β V β V β V"
where "prodfunctor_proj π I π π J c =
[
(Ξ»bββ©β(ββ©Ciββ©βI -β©β J. π i)β¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦),
(Ξ»fββ©β(ββ©Ciββ©βI -β©β J. π i)β¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β (ββ©Cjββ©βJ. π j)β¦CIdβ¦β¦cβ¦β¦),
(ββ©Ciββ©βI -β©β J. π i),
π
]β©β"
syntax "_PPRODFUNCTOR_PROJ" :: "V β pttrn β V β V β (V β V) β V β V β V"
(βΉ(_β(3ββ©C_ββ©β_-β©β_./_),_β/'(/-,_/'))βΊ [51, 51, 51, 51, 51, 51, 51] 51)
translations "πβββ©Ciββ©βI-β©βJ. π,πβ(-,c)" β
"CONST prodfunctor_proj π I (Ξ»i. π) π J c"
textβΉComponents.βΊ
lemma prodfunctor_proj_components:
shows "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c))β¦ObjMapβ¦ =
(Ξ»bββ©β(ββ©Ciββ©βI -β©β J. π i)β¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦)"
and "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c))β¦ArrMapβ¦ =
(Ξ»fββ©β(ββ©Ciββ©βI -β©β J. π i)β¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β (ββ©Cjββ©βJ. π j)β¦CIdβ¦β¦cβ¦β¦)"
and "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c))β¦HomDomβ¦ = (ββ©Ciββ©βI -β©β J. π i)"
and "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c))β¦HomCodβ¦ = π"
unfolding prodfunctor_proj_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda prodfunctor_proj_components(1)
|vsv prodfunctor_proj_ObjMap_vsv[cat_cs_intros]|
|vdomain prodfunctor_proj_ObjMap_vdomain[cat_cs_simps]|
|app prodfunctor_proj_ObjMap_app[cat_cs_simps]|
subsubsectionβΉArrow mapβΊ
mk_VLambda prodfunctor_proj_components(2)
|vsv prodfunctor_proj_ArrMap_vsv[cat_cs_intros]|
|vdomain prodfunctor_proj_ArrMap_vdomain[cat_cs_simps]|
|app prodfunctor_proj_ArrMap_app[cat_cs_simps]|
subsubsectionβΉProdfunctor with respect to a fixed argument is a functorβΊ
lemma (in pcategory) pcat_prodfunctor_proj_is_functor:
assumes "π : (ββ©Ciββ©βI. π i) β¦β¦β©CβΞ±β π"
and "c ββ©β (ββ©Cjββ©βJ. π j)β¦Objβ¦"
and "J ββ©β I"
shows "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c)) : (ββ©Ciββ©βI -β©β J. π i) β¦β¦β©CβΞ±β π"
proof-
interpret is_functor Ξ± βΉ(ββ©Ciββ©βI. π i)βΊ π π by (rule assms(1))
interpret π: pcategory Ξ± J π
using assms(3) by (intro pcat_vsubset_index_pcategory) auto
interpret J_π: category Ξ± βΉββ©Ciββ©βJ. π iβΊ by (rule π.pcat_category_cat_prod)
interpret IJ: pcategory Ξ± βΉI -β©β JβΊ π
using assms(3) by (intro pcat_vsubset_index_pcategory) auto
interpret IJ_π: category Ξ± βΉββ©Ciββ©βI -β©β J. π iβΊ
by (rule IJ.pcat_category_cat_prod)
let ?IJπ = βΉ(ββ©Ciββ©βI -β©β J. π i)βΊ
from assms(2) have "c ββ©β (ββ©βjββ©βJ. π jβ¦Objβ¦)"
unfolding cat_prod_components by simp
then have "(ββ©βjββ©βJ. π jβ¦Objβ¦) β 0" by (auto intro!: cat_cs_intros)
show ?thesis
proof(intro is_functorI', unfold prodfunctor_proj_components)
show "vfsequence (prodfunctor_proj π I π π J c)"
unfolding prodfunctor_proj_def by simp
show "vcard (prodfunctor_proj π I π π J c) = 4β©β"
unfolding prodfunctor_proj_def by (simp add: nat_omega_simps)
show "ββ©β (Ξ»bββ©β?IJπβ¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦) ββ©β πβ¦Objβ¦"
proof(intro vsubsetI)
fix x assume "x ββ©β ββ©β (Ξ»bββ©β?IJπβ¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦)"
then obtain b where x_def: "x = πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦" and b: "b ββ©β ?IJπβ¦Objβ¦"
by auto
have "b βͺβ©β c ββ©β cat_prod I πβ¦Objβ¦"
proof(rule cat_prod_vdiff_vunion_Obj_in_Obj)
show "b ββ©β ?IJπβ¦Objβ¦" by (rule b)
qed (intro assms(2,3))+
then show "x ββ©β πβ¦Objβ¦" unfolding x_def by (auto intro: cat_cs_intros)
qed
show is_arr:
"(Ξ»fββ©β?IJπβ¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦)β¦fβ¦ :
(Ξ»bββ©β?IJπβ¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦)β¦aβ¦ β¦βπβ
(Ξ»bββ©β?IJπβ¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦)β¦bβ¦"
(is βΉ?V_f: ?V_a β¦βπβ ?V_bβΊ)
if "f : a β¦β?IJπβ b" for f a b
proof-
let ?fc = βΉf βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦βΊ
have "?fc : a βͺβ©β c β¦βcat_prod I πβ b βͺβ©β c"
proof(rule pcat_cat_prod_vdiff_vunion_is_arr)
show "f : a β¦β?IJπβ b" by (rule that)
qed (auto simp: assms cat_cs_intros)
then have "πβ¦ArrMapβ¦β¦?fcβ¦ : πβ¦ObjMapβ¦β¦a βͺβ©β cβ¦ β¦βπβ πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦"
by (auto intro: cat_cs_intros)
moreover from that have "f ββ©β ?IJπβ¦Arrβ¦" "a ββ©β ?IJπβ¦Objβ¦" "b ββ©β ?IJπβ¦Objβ¦"
by (auto intro: cat_cs_intros)
ultimately show ?thesis by simp
qed
show
"(Ξ»fββ©β?IJπβ¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦)β¦g ββ©Aβ?IJπβ fβ¦ =
(Ξ»fββ©β?IJπβ¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦)β¦gβ¦ ββ©Aβπβ
(Ξ»fββ©β?IJπβ¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦)β¦fβ¦"
if "g : b' β¦β?IJπβ c'" and "f : a' β¦β?IJπβ b'" for g b' c' f a'
proof-
from that have gf: "g ββ©Aβ?IJπβ f : a' β¦β?IJπβ c'"
by (auto intro: cat_cs_intros)
from assms(2) have CId_c: "cat_prod J πβ¦CIdβ¦β¦cβ¦ : c β¦βcat_prod J πβ c"
by (auto intro: cat_cs_intros)
then have [simp]:
"cat_prod J πβ¦CIdβ¦β¦cβ¦ ββ©Aβcat_prod J πβ cat_prod J πβ¦CIdβ¦β¦cβ¦ =
cat_prod J πβ¦CIdβ¦β¦cβ¦"
by (auto simp: cat_cs_simps)
from assms(3) that(1) CId_c have g_CId_c:
"g βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦ : b' βͺβ©β c β¦βcat_prod I πβ c' βͺβ©β c"
by (rule pcat_cat_prod_vdiff_vunion_is_arr)
from assms(3) that(2) CId_c have f_CId_c:
"f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦ : a' βͺβ©β c β¦βcat_prod I πβ b' βͺβ©β c"
by (rule pcat_cat_prod_vdiff_vunion_is_arr)
have
"πβ¦ArrMapβ¦β¦(g ββ©Aβ?IJπβ f) βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦ =
πβ¦ArrMapβ¦β¦g βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦ ββ©Aβπβ
πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦"
unfolding
pcat_cat_prod_vdiff_vunion_Comp[
OF assms(3) that(1) CId_c that(2) CId_c, simplified
]
by (intro cf_ArrMap_Comp[OF g_CId_c f_CId_c])
moreover from gf have "g ββ©Aβ?IJπβ f ββ©β ?IJπβ¦Arrβ¦" by auto
moreover from that have "g ββ©β ?IJπβ¦Arrβ¦" "f ββ©β ?IJπβ¦Arrβ¦" by auto
ultimately show ?thesis by simp
qed
show
"(Ξ»fββ©β?IJπβ¦Arrβ¦. πβ¦ArrMapβ¦β¦f βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦)β¦?IJπβ¦CIdβ¦β¦c'β¦β¦ =
πβ¦CIdβ¦β¦(Ξ»bββ©β?IJπβ¦Objβ¦. πβ¦ObjMapβ¦β¦b βͺβ©β cβ¦)β¦c'β¦β¦"
if "c' ββ©β ?IJπβ¦Objβ¦" for c'
proof-
have "?IJπβ¦CIdβ¦β¦c'β¦ βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦ = cat_prod I πβ¦CIdβ¦β¦c' βͺβ©β cβ¦"
unfolding pcat_cat_prod_vdiff_vunion_CId[OF assms(3) that assms(2)] ..
moreover from assms(3) that assms(2) have "c' βͺβ©β c ββ©β cat_prod I πβ¦Objβ¦"
by (rule cat_prod_vdiff_vunion_Obj_in_Obj)
ultimately have "πβ¦ArrMapβ¦β¦?IJπβ¦CIdβ¦β¦c'β¦ βͺβ©β cat_prod J πβ¦CIdβ¦β¦cβ¦β¦ =
πβ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦c' βͺβ©β cβ¦β¦"
by (auto intro: cat_cs_intros)
moreover from that have CId_c': "?IJπβ¦CIdβ¦β¦c'β¦ ββ©β ?IJπβ¦Arrβ¦"
by (auto dest!: IJ_π.cat_CId_is_arr)
ultimately show ?thesis by (simp add: that)
qed
qed (auto intro: cat_cs_intros)
qed
lemma (in pcategory) pcat_prodfunctor_proj_is_functor':
assumes "π : (ββ©Ciββ©βI. π i) β¦β¦β©CβΞ±β π"
and "c ββ©β (ββ©Cjββ©βJ. π j)β¦Objβ¦"
and "J ββ©β I"
and "π' = (ββ©Ciββ©βI -β©β J. π i)"
and "π
' = π"
shows "(πβββ©Ciββ©βI -β©β J. π i,πβ(-,c)) : π' β¦β¦β©CβΞ±β π
'"
using assms(1-3)
unfolding assms(4,5)
by (rule pcat_prodfunctor_proj_is_functor)
lemmas [cat_cs_intros] = pcategory.pcat_prodfunctor_proj_is_functor'
subsectionβΉSingleton categoryβΊ
subsubsectionβΉSlicingβΊ
context
fixes β :: V
begin
lemmas_with [where β=βΉcat_smc ββΊ, unfolded slicing_simps slicing_commute]:
cat_singleton_ObjI = smc_singleton_ObjI
and cat_singleton_ObjE = smc_singleton_ObjE
and cat_singleton_ArrI = smc_singleton_ArrI
and cat_singleton_ArrE = smc_singleton_ArrE
end
context category
begin
interpretation smc: semicategory Ξ± βΉcat_smc ββΊ by (rule cat_semicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
cat_finite_psemicategory_cat_singleton =
smc.smc_finite_psemicategory_smc_singleton
and cat_singleton_is_arrI = smc.smc_singleton_is_arrI
and cat_singleton_is_arrD = smc.smc_singleton_is_arrD
and cat_singleton_is_arrE = smc.smc_singleton_is_arrE
end
subsubsectionβΉIdentityβΊ
lemma cat_singleton_CId_app:
assumes "set {β¨j, aβ©} ββ©β (ββ©Ciββ©βset {j}. β)β¦Objβ¦"
shows "(ββ©Ciββ©βset {j}. β)β¦CIdβ¦β¦set {β¨j, aβ©}β¦ = set {β¨j, ββ¦CIdβ¦β¦aβ¦β©}"
using assms unfolding cat_prod_components VLambda_vsingleton by simp
subsubsectionβΉSingleton category is a categoryβΊ
lemma (in category) cat_finite_pcategory_cat_singleton:
assumes "j ββ©β Vset Ξ±"
shows "finite_pcategory Ξ± (set {j}) (Ξ»i. β)"
by
(
auto intro:
assms
category_axioms
finite_pcategory_finite_psemicategoryI
cat_finite_psemicategory_cat_singleton
)
lemma (in category) cat_category_cat_singleton:
assumes "j ββ©β Vset Ξ±"
shows "category Ξ± (ββ©Ciββ©βset {j}. β)"
proof-
interpret finite_pcategory Ξ± βΉset {j}βΊ βΉΞ»i. ββΊ
using assms by (rule cat_finite_pcategory_cat_singleton)
show ?thesis by (rule pcat_category_cat_prod)
qed
subsectionβΉSingleton functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_singleton :: "V β V β V"
where "cf_singleton j β =
[
(Ξ»aββ©βββ¦Objβ¦. set {β¨j, aβ©}),
(Ξ»fββ©βββ¦Arrβ¦. set {β¨j, fβ©}),
β,
(ββ©Ciββ©βset {j}. β)
]β©β"
textβΉComponents.βΊ
lemma cf_singleton_components:
shows "cf_singleton j ββ¦ObjMapβ¦ = (Ξ»aββ©βββ¦Objβ¦. set {β¨j, aβ©})"
and "cf_singleton j ββ¦ArrMapβ¦ = (Ξ»fββ©βββ¦Arrβ¦. set {β¨j, fβ©})"
and "cf_singleton j ββ¦HomDomβ¦ = β"
and "cf_singleton j ββ¦HomCodβ¦ = (ββ©Ciββ©βset {j}. β)"
unfolding cf_singleton_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cf_smcf_cf_singleton[slicing_commute]:
"smcf_singleton j (cat_smc β)= cf_smcf (cf_singleton j β)"
unfolding smcf_singleton_def cf_singleton_def slicing_simps slicing_commute
by
(
simp add:
nat_omega_simps dghm_field_simps dg_field_simps cat_smc_def cf_smcf_def
)
context
fixes β :: V
begin
lemmas_with [where β=βΉcat_smc ββΊ, unfolded slicing_simps slicing_commute]:
cf_singleton_ObjMap_vsv[cat_cs_intros] = smcf_singleton_ObjMap_vsv
and cf_singleton_ObjMap_vdomain[cat_cs_simps] = smcf_singleton_ObjMap_vdomain
and cf_singleton_ObjMap_vrange = smcf_singleton_ObjMap_vrange
and cf_singleton_ObjMap_app[cat_prod_cs_simps] = smcf_singleton_ObjMap_app
and cf_singleton_ArrMap_vsv[cat_cs_intros] = smcf_singleton_ArrMap_vsv
and cf_singleton_ArrMap_vdomain[cat_cs_simps] = smcf_singleton_ArrMap_vdomain
and cf_singleton_ArrMap_vrange = smcf_singleton_ArrMap_vrange
and cf_singleton_ArrMap_app[cat_prod_cs_simps] = smcf_singleton_ArrMap_app
end
subsubsectionβΉSingleton functor is an isomorphism of categoriesβΊ
lemma (in category) cat_cf_singleton_is_functor:
assumes "j ββ©β Vset Ξ±"
shows "cf_singleton j β : β β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β (ββ©Ciββ©βset {j}. β)"
proof(intro is_iso_functorI is_functorI)
from assms show smcf_singleton: "cf_smcf (cf_singleton j β) :
cat_smc β β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β cat_smc (ββ©Ciββ©βset {j}. β)"
unfolding slicing_commute[symmetric]
by (intro semicategory.smc_smcf_singleton_is_iso_semifunctor)
(auto intro: smc_cs_intros slicing_intros)
show "vfsequence (cf_singleton j β)" unfolding cf_singleton_def by simp
show "vcard (cf_singleton j β) = 4β©β"
unfolding cf_singleton_def by (simp add: nat_omega_simps)
show "cf_smcf (cf_singleton j β) :
cat_smc β β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc (ββ©Ciββ©βset {j}. β)"
by (intro is_iso_semifunctor.axioms(1) smcf_singleton)
show "cf_singleton j ββ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ =
(ββ©Ciββ©βset {j}. β)β¦CIdβ¦β¦cf_singleton j ββ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β ββ¦Objβ¦" for c
proof-
from that have CId_c: "ββ¦CIdβ¦β¦cβ¦ : c β¦βββ c" by (auto simp: cat_cs_intros)
have "set {β¨j, cβ©} ββ©β (ββ©Ciββ©βset {j}. β)β¦Objβ¦"
by (simp add: cat_singleton_ObjI that)
with that have "(ββ©Ciββ©βset {j}. β)β¦CIdβ¦β¦cf_singleton j ββ¦ObjMapβ¦β¦cβ¦β¦ =
set {β¨j, ββ¦CIdβ¦β¦cβ¦β©}"
by (simp add: cf_singleton_ObjMap_app cat_singleton_CId_app)
moreover from CId_c have
"cf_singleton j ββ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ = set {β¨j, ββ¦CIdβ¦β¦cβ¦β©}"
by (auto simp: cf_singleton_ArrMap_app cat_cs_intros)
ultimately show ?thesis by simp
qed
qed
(
auto simp:
cat_cs_intros assms cat_category_cat_singleton cf_singleton_components
)
subsectionβΉProduct of two categoriesβΊ
subsubsectionβΉDefinition and elementary properties.βΊ
textβΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.βΊ
definition cat_prod_2 :: "V β V β V" (infixr βΉΓβ©CβΊ 80)
where "π Γβ©C π
β‘ cat_prod (2β©β) (Ξ»i. if i = 0 then π else π
)"
textβΉSlicing.βΊ
lemma cat_smc_cat_prod_2[slicing_commute]:
"cat_smc π Γβ©Sβ©Mβ©C cat_smc π
= cat_smc (π Γβ©C π
)"
unfolding cat_prod_2_def smc_prod_2_def slicing_commute[symmetric] if_distrib
by simp
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
lemmas_with
[
where π=βΉcat_smc πβΊ and π
=βΉcat_smc π
βΊ,
unfolded slicing_simps slicing_commute,
OF π.cat_semicategory π
.cat_semicategory
]:
cat_prod_2_ObjI = smc_prod_2_ObjI
and cat_prod_2_ObjI'[cat_prod_cs_intros] = smc_prod_2_ObjI'
and cat_prod_2_ObjE = smc_prod_2_ObjE
and cat_prod_2_ArrI = smc_prod_2_ArrI
and cat_prod_2_ArrI'[cat_prod_cs_intros] = smc_prod_2_ArrI'
and cat_prod_2_ArrE = smc_prod_2_ArrE
and cat_prod_2_is_arrI = smc_prod_2_is_arrI
and cat_prod_2_is_arrI'[cat_prod_cs_intros] = smc_prod_2_is_arrI'
and cat_prod_2_is_arrE = smc_prod_2_is_arrE
and cat_prod_2_Dom_vsv = smc_prod_2_Dom_vsv
and cat_prod_2_Dom_vdomain[cat_cs_simps] = smc_prod_2_Dom_vdomain
and cat_prod_2_Dom_app[cat_prod_cs_simps] = smc_prod_2_Dom_app
and cat_prod_2_Dom_vrange = smc_prod_2_Dom_vrange
and cat_prod_2_Cod_vsv = smc_prod_2_Cod_vsv
and cat_prod_2_Cod_vdomain[cat_cs_simps] = smc_prod_2_Cod_vdomain
and cat_prod_2_Cod_app[cat_prod_cs_simps] = smc_prod_2_Cod_app
and cat_prod_2_Cod_vrange = smc_prod_2_Cod_vrange
and cat_prod_2_op_cat_cat_Obj[cat_op_simps] = smc_prod_2_op_smc_smc_Obj
and cat_prod_2_cat_op_cat_Obj[cat_op_simps] = smc_prod_2_smc_op_smc_Obj
and cat_prod_2_op_cat_cat_Arr[cat_op_simps] = smc_prod_2_op_smc_smc_Arr
and cat_prod_2_cat_op_cat_Arr[cat_op_simps] = smc_prod_2_smc_op_smc_Arr
lemmas_with
[
where π=βΉcat_smc πβΊ and π
=βΉcat_smc π
βΊ,
unfolded slicing_simps slicing_commute,
OF π.cat_semicategory π
.cat_semicategory
]:
cat_prod_2_Comp_app[cat_prod_cs_simps] = smc_prod_2_Comp_app
end
subsubsectionβΉProduct of two categories is a categoryβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π΅ Ξ± by (rule categoryD[OF π])
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
lemma finite_pcategory_cat_prod_2: "finite_pcategory Ξ± (2β©β) (if2 π π
)"
proof(intro finite_pcategoryI pcategory_baseI)
from Axiom_of_Infinity show z1_in_Vset: "2β©β ββ©β Vset Ξ±" by blast
show "category Ξ± (i = 0 ? π : π
)" if "i ββ©β 2β©β" for i
by (auto simp: cat_cs_intros)
qed auto
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemma category_cat_prod_2[cat_cs_intros]: "category Ξ± (π Γβ©C π
)"
unfolding cat_prod_2_def by (rule pcat_category_cat_prod)
end
subsubsectionβΉIdentityβΊ
lemma cat_prod_2_CId_vsv[cat_cs_intros]: "vsv ((π Γβ©C π
)β¦CIdβ¦)"
unfolding cat_prod_2_def cat_prod_components by simp
lemma cat_prod_2_CId_vdomain[cat_cs_simps]:
"πβ©β ((π Γβ©C π
)β¦CIdβ¦) = (π Γβ©C π
)β¦Objβ¦"
unfolding cat_prod_2_def cat_prod_components by simp
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉ(Ξ»i. if i = 0 then π else π
)βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemma cat_prod_2_CId_app[cat_prod_cs_simps]:
assumes "[a, b]β©β ββ©β (π Γβ©C π
)β¦Objβ¦"
shows "(π Γβ©C π
)β¦CIdβ¦β¦a, bβ¦β©β = [πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦]β©β"
proof-
have "(π Γβ©C π
)β¦CIdβ¦ β¦a, bβ¦β©β =
(Ξ»iββ©β2β©β. (if i = 0 then π else π
)β¦CIdβ¦β¦[a, b]β©ββ¦iβ¦β¦)"
by
(
rule
cat_prod_CId_app[
OF assms[unfolded cat_prod_2_def], folded cat_prod_2_def
]
)
also have
"(Ξ»iββ©β2β©β. (if i = 0 then π else π
)β¦CIdβ¦β¦[a, b]β©ββ¦iβ¦β¦) =
[πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦]β©β"
proof(rule vsv_eqI, unfold vdomain_VLambda)
fix i assume "i ββ©β 2β©β"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ unfolding two by auto
then show
"(Ξ»iββ©β2β©β. (if i = 0 then π else π
)β¦CIdβ¦β¦[a, b]β©ββ¦iβ¦β¦)β¦iβ¦ =
[πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦]β©ββ¦iβ¦"
by cases (simp_all add: two nat_omega_simps)
qed (auto simp: two nat_omega_simps)
finally show ?thesis by simp
qed
lemma cat_prod_2_CId_vrange: "ββ©β ((π Γβ©C π
)β¦CIdβ¦) ββ©β (π Γβ©C π
)β¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
show "vsv ((π Γβ©C π
)β¦CIdβ¦)" by (rule cat_prod_2_CId_vsv)
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF π π
])
from π π
a b show "(π Γβ©C π
)β¦CIdβ¦β¦abβ¦ ββ©β (π Γβ©C π
)β¦Arrβ¦"
unfolding ab_def
by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
end
subsubsectionβΉOpposite product categoryβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
lemma op_smc_smc_prod_2[smc_op_simps]:
"op_cat (π Γβ©C π
) = op_cat π Γβ©C op_cat π
"
proof(rule cat_smc_eqI [of Ξ±])
from π π
show cat_lhs: "category Ξ± (op_cat (π Γβ©C π
))"
by
(
cs_concl
cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
)
interpret cat_lhs: category Ξ± βΉop_cat (π Γβ©C π
)βΊ by (rule cat_lhs)
from π π
show cat_rhs: "category Ξ± (op_cat π Γβ©C op_cat π
)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
interpret cat_rhs: category Ξ± βΉop_cat π Γβ©C op_cat π
βΊ by (rule cat_rhs)
show "op_cat (π Γβ©C π
)β¦CIdβ¦ = (op_cat π Γβ©C op_cat π
)β¦CIdβ¦"
unfolding cat_op_simps
proof(rule vsv_eqI, unfold cat_cs_simps)
show "vsv ((π Γβ©C π
)β¦CIdβ¦)" by (rule cat_prod_2_CId_vsv)
show "vsv ((op_cat π Γβ©C op_cat π
)β¦CIdβ¦)" by (rule cat_prod_2_CId_vsv)
from π π
show "(π Γβ©C π
)β¦Objβ¦ = (op_cat π Γβ©C op_cat π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
show "(π Γβ©C π
)β¦CIdβ¦β¦abβ¦ = (op_cat π Γβ©C op_cat π
)β¦CIdβ¦β¦abβ¦"
if "ab ββ©β (π Γβ©C π
)β¦Objβ¦" for ab
using that unfolding cat_cs_simps
proof-
from that obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF π π
])
from π π
a b show "(π Γβ©C π
)β¦CIdβ¦β¦abβ¦ = (op_cat π Γβ©C op_cat π
)β¦CIdβ¦β¦abβ¦"
unfolding ab_def
by
(
cs_concl
cs_simp: cat_op_simps cat_prod_cs_simps
cs_intro: cat_op_intros cat_prod_cs_intros
)
qed
qed
from π π
show "cat_smc (op_cat (π Γβ©C π
)) = cat_smc (op_cat π Γβ©C op_cat π
)"
unfolding slicing_commute[symmetric]
by (cs_concl cs_simp: smc_op_simps cs_intro: slicing_intros)
qed
end
subsubsectionβΉFlipβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
lemma cat_prod_2_Obj_fconverse[cat_cs_simps]:
"((π Γβ©C π
)β¦Objβ¦)Β―β©β = (π
Γβ©C π)β¦Objβ¦"
proof-
interpret fbrelation βΉ((π Γβ©C π
)β¦Objβ¦)βΊ
by (auto elim: cat_prod_2_ObjE[OF π π
])
show ?thesis
proof(intro vsubset_antisym vsubsetI)
fix ba assume prems: "ba ββ©β ((π Γβ©C π
)β¦Objβ¦)Β―β©β"
then obtain a b where ba_def: "ba = [b, a]β©β" by clarsimp
from prems[unfolded ba_def] have "[a, b]β©β ββ©β (π Γβ©C π
)β¦Objβ¦" by auto
then have "a ββ©β πβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
by (auto elim: cat_prod_2_ObjE[OF π π
])
with π π
show "ba ββ©β (π
Γβ©C π)β¦Objβ¦"
unfolding ba_def by (cs_concl cs_intro: cat_prod_cs_intros)
next
fix ba assume "ba ββ©β (π
Γβ©C π)β¦Objβ¦"
then obtain a b
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF π
π])
from b a show "ba ββ©β ((π Γβ©C π
)β¦Objβ¦)Β―β©β"
unfolding ba_def by (auto simp: cat_prod_2_ObjI[OF π π
a b])
qed
qed
lemma cat_prod_2_Arr_fconverse[cat_cs_simps]:
"((π Γβ©C π
)β¦Arrβ¦)Β―β©β = (π
Γβ©C π)β¦Arrβ¦"
proof-
interpret fbrelation βΉ((π Γβ©C π
)β¦Arrβ¦)βΊ
by (auto elim: cat_prod_2_ArrE[OF π π
])
show ?thesis
proof(intro vsubset_antisym vsubsetI)
fix ba assume prems: "ba ββ©β ((π Γβ©C π
)β¦Arrβ¦)Β―β©β"
then obtain a b where ba_def: "ba = [b, a]β©β" by clarsimp
from prems[unfolded ba_def] have "[a, b]β©β ββ©β (π Γβ©C π
)β¦Arrβ¦" by auto
then have "a ββ©β πβ¦Arrβ¦" and "b ββ©β π
β¦Arrβ¦"
by (auto elim: cat_prod_2_ArrE[OF π π
])
with π π
show "ba ββ©β (π
Γβ©C π)β¦Arrβ¦"
unfolding ba_def
by
(
cs_concl
cs_simp: cat_prod_cs_simps
cs_intro: cat_prod_cs_intros cat_cs_intros
)
next
fix ba assume "ba ββ©β (π
Γβ©C π)β¦Arrβ¦"
then obtain a b
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Arrβ¦"
and a: "a ββ©β πβ¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF π
π])
from b a show "ba ββ©β ((π Γβ©C π
)β¦Arrβ¦)Β―β©β"
unfolding ba_def by (auto simp: cat_prod_2_ArrI[OF π π
a b])
qed
qed
end
subsectionβΉProjections for the product of two categoriesβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.βΊ
definition cf_proj_fst :: "V β V β V" (βΉΟβ©Cβ©.β©1βΊ)
where "Οβ©Cβ©.β©1 π π
= cf_proj (2β©β) (Ξ»i. if i = 0 then π else π
) 0"
definition cf_proj_snd :: "V β V β V" (βΉΟβ©Cβ©.β©2βΊ)
where "Οβ©Cβ©.β©2 π π
= cf_proj (2β©β) (Ξ»i. if i = 0 then π else π
) (1β©β)"
textβΉSlicingβΊ
lemma cf_smcf_cf_proj_fst[slicing_commute]:
"Οβ©Sβ©Mβ©Cβ©.β©1 (cat_smc π) (cat_smc π
) = cf_smcf (Οβ©Cβ©.β©1 π π
)"
unfolding
cf_proj_fst_def smcf_proj_fst_def slicing_commute[symmetric] if_distrib ..
lemma cf_smcf_cf_proj_snd[slicing_commute]:
"Οβ©Sβ©Mβ©Cβ©.β©2 (cat_smc π) (cat_smc π
) = cf_smcf (Οβ©Cβ©.β©2 π π
)"
unfolding
cf_proj_snd_def smcf_proj_snd_def slicing_commute[symmetric] if_distrib ..
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
lemmas_with
[
where π=βΉcat_smc πβΊ and π
=βΉcat_smc π
βΊ,
unfolded slicing_simps slicing_commute,
OF π.cat_semicategory π
.cat_semicategory
]:
cf_proj_fst_ObjMap_app = smcf_proj_fst_ObjMap_app
and cf_proj_snd_ObjMap_app = smcf_proj_snd_ObjMap_app
and cf_proj_fst_ArrMap_app = smcf_proj_fst_ArrMap_app
and cf_proj_snd_ArrMap_app = smcf_proj_snd_ArrMap_app
end
subsubsectionβΉ
Domain and codomain of a projection of a product of two categories
βΊ
lemma cf_proj_fst_HomDom: "Οβ©Cβ©.β©1 π π
β¦HomDomβ¦ = π Γβ©C π
"
unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def ..
lemma cf_proj_fst_HomCod: "Οβ©Cβ©.β©1 π π
β¦HomCodβ¦ = π"
unfolding cf_proj_fst_def cf_proj_components cat_prod_2_def by simp
lemma cf_proj_snd_HomDom: "Οβ©Cβ©.β©2 π π
β¦HomDomβ¦ = π Γβ©C π
"
unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def ..
lemma cf_proj_snd_HomCod: "Οβ©Cβ©.β©2 π π
β¦HomCodβ¦ = π
"
unfolding cf_proj_snd_def cf_proj_components cat_prod_2_def by simp
subsubsectionβΉProjection of a product of two categories is a functorβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π΅ Ξ± by (rule categoryD[OF π])
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemma cf_proj_fst_is_functor:
assumes "i ββ©β I"
shows "Οβ©Cβ©.β©1 π π
: π Γβ©C π
β¦β¦β©CβΞ±β π"
by
(
rule
pcat_cf_proj_is_functor[
where i=0, simplified, folded cf_proj_fst_def cat_prod_2_def
]
)
lemma cf_proj_fst_is_functor'[cat_cs_intros]:
assumes "i ββ©β I" and "β = π Γβ©C π
" and "π = π"
shows "Οβ©Cβ©.β©1 π π
: β β¦β¦β©CβΞ±β π"
using assms(1) unfolding assms(2,3) by (rule cf_proj_fst_is_functor)
lemma cf_proj_snd_is_functor:
assumes "i ββ©β I"
shows "Οβ©Cβ©.β©2 π π
: π Γβ©C π
β¦β¦β©CβΞ±β π
"
by
(
rule
pcat_cf_proj_is_functor[
where i=βΉ1β©ββΊ, simplified, folded cf_proj_snd_def cat_prod_2_def
]
)
lemma cf_proj_snd_is_functor'[cat_cs_intros]:
assumes "i ββ©β I" and "β = π Γβ©C π
" and "π = π
"
shows "Οβ©Cβ©.β©2 π π
: β β¦β¦β©CβΞ±β π"
using assms(1) unfolding assms(2,3) by (rule cf_proj_snd_is_functor)
end
subsectionβΉProduct of three categoriesβΊ
subsubsectionβΉDefinition and elementary properties.βΊ
definition cat_prod_3 :: "V β V β V β V" ("(_ Γβ©Cβ©3 _ Γβ©Cβ©3 _)" [81, 81, 81] 80)
where "π Γβ©Cβ©3 π
Γβ©Cβ©3 β = (ββ©Ciββ©β3β©β. if3 π π
β i)"
abbreviation cat_pow_3 :: "V β V" (βΉ_^β©Cβ©3βΊ [81] 80)
where "β^β©Cβ©3 β‘ β Γβ©Cβ©3 β Γβ©Cβ©3 β"
textβΉSlicing.βΊ
lemma cat_smc_cat_prod_3[slicing_commute]:
"cat_smc π Γβ©Sβ©Mβ©Cβ©3 cat_smc π
Γβ©Sβ©Mβ©Cβ©3 cat_smc β = cat_smc (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)"
unfolding cat_prod_3_def smc_prod_3_def slicing_commute[symmetric] if_distrib
by (simp add: if_distrib[symmetric])
context
fixes Ξ± π π
β
assumes π: "category Ξ± π" and π
: "category Ξ± π
" and β: "category Ξ± β"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation β: category Ξ± β by (rule β)
lemmas_with
[
where π=βΉcat_smc πβΊ and π
=βΉcat_smc π
βΊ and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute,
OF π.cat_semicategory π
.cat_semicategory β.cat_semicategory
]:
cat_prod_3_ObjI = smc_prod_3_ObjI
and cat_prod_3_ObjI'[cat_prod_cs_intros] = smc_prod_3_ObjI'
and cat_prod_3_ObjE = smc_prod_3_ObjE
and cat_prod_3_ArrI = smc_prod_3_ArrI
and cat_prod_3_ArrI'[cat_prod_cs_intros] = smc_prod_3_ArrI'
and cat_prod_3_ArrE = smc_prod_3_ArrE
and cat_prod_3_is_arrI = smc_prod_3_is_arrI
and cat_prod_3_is_arrI'[cat_prod_cs_intros] = smc_prod_3_is_arrI'
and cat_prod_3_is_arrE = smc_prod_3_is_arrE
and cat_prod_3_Dom_vsv = smc_prod_3_Dom_vsv
and cat_prod_3_Dom_vdomain[cat_cs_simps] = smc_prod_3_Dom_vdomain
and cat_prod_3_Dom_app[cat_prod_cs_simps] = smc_prod_3_Dom_app
and cat_prod_3_Dom_vrange = smc_prod_3_Dom_vrange
and cat_prod_3_Cod_vsv = smc_prod_3_Cod_vsv
and cat_prod_3_Cod_vdomain[cat_cs_simps] = smc_prod_3_Cod_vdomain
and cat_prod_3_Cod_app[cat_prod_cs_simps] = smc_prod_3_Cod_app
and cat_prod_3_Cod_vrange = smc_prod_3_Cod_vrange
lemmas_with
[
where π=βΉcat_smc πβΊ and π
=βΉcat_smc π
βΊ and β=βΉcat_smc ββΊ,
unfolded slicing_simps slicing_commute,
OF π.cat_semicategory π
.cat_semicategory β.cat_semicategory
]:
cat_prod_3_Comp_app[cat_prod_cs_simps] = smc_prod_3_Comp_app
end
subsubsectionβΉProduct of three categories is a categoryβΊ
context
fixes Ξ± π π
β
assumes π: "category Ξ± π" and π
: "category Ξ± π
" and β: "category Ξ± β"
begin
interpretation π΅ Ξ± by (rule categoryD[OF π])
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation β: category Ξ± β by (rule β)
lemma finite_pcategory_cat_prod_3: "finite_pcategory Ξ± (3β©β) (if3 π π
β)"
proof(intro finite_pcategoryI pcategory_baseI)
from Axiom_of_Infinity show z1_in_Vset: "3β©β ββ©β Vset Ξ±" by blast
show "category Ξ± (if3 π π
β i)" if "i ββ©β 3β©β" for i
by (auto simp: cat_cs_intros)
qed auto
interpretation finite_pcategory Ξ± βΉ3β©ββΊ βΉif3 π π
ββΊ
by (intro finite_pcategory_cat_prod_3 π π
β)
lemma category_cat_prod_3[cat_cs_intros]: "category Ξ± (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)"
unfolding cat_prod_3_def by (rule pcat_category_cat_prod)
end
subsubsectionβΉIdentityβΊ
lemma cat_prod_3_CId_vsv[cat_cs_intros]: "vsv ((π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦)"
unfolding cat_prod_3_def cat_prod_components by simp
lemma cat_prod_3_CId_vdomain[cat_cs_simps]:
"πβ©β ((π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦) = (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
unfolding cat_prod_3_def cat_prod_components by simp
context
fixes Ξ± π π
β
assumes π: "category Ξ± π" and π
: "category Ξ± π
" and β: "category Ξ± β"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation β: category Ξ± β by (rule β)
interpretation finite_pcategory Ξ± βΉ3β©ββΊ βΉif3 π π
ββΊ
by (intro finite_pcategory_cat_prod_3 π π
β)
lemma cat_prod_3_CId_app[cat_prod_cs_simps]:
assumes "[a, b, c]β©β ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
shows "(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦β¦a, b, cβ¦β©β = [πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦, ββ¦CIdβ¦β¦cβ¦]β©β"
proof-
have "(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦β¦a, b, cβ¦β©β =
(Ξ»iββ©β3β©β. if3 π π
β iβ¦CIdβ¦β¦[a, b, c]β©ββ¦iβ¦β¦)"
by
(
rule
cat_prod_CId_app[
OF assms[unfolded cat_prod_3_def], folded cat_prod_3_def
]
)
also have
"(Ξ»iββ©β3β©β. if3 π π
β iβ¦CIdβ¦β¦[a, b, c]β©ββ¦iβ¦β¦) = [πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦, ββ¦CIdβ¦β¦cβ¦]β©β"
proof(rule vsv_eqI, unfold vdomain_VLambda)
fix i assume "i ββ©β 3β©β"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ unfolding three by auto
then show
"(Ξ»iββ©β3β©β. (if3 π π
β i)β¦CIdβ¦β¦[a, b, c]β©ββ¦iβ¦β¦)β¦iβ¦ =
[πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦, ββ¦CIdβ¦β¦cβ¦]β©ββ¦iβ¦"
by cases (simp_all add: three nat_omega_simps)
qed (auto simp: three nat_omega_simps)
finally show ?thesis by simp
qed
lemma cat_prod_3_CId_vrange:
"ββ©β ((π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦) ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
show "vsv ((π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦)" by (rule cat_prod_3_CId_vsv)
fix abc assume "abc ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
then obtain a b c where abc_def: "abc = [a, b, c]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
and c: "c ββ©β ββ¦Objβ¦"
by (elim cat_prod_3_ObjE[OF π π
β])
from π π
β a b c show "(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦β¦abcβ¦ ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦"
unfolding abc_def
by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
end
subsectionβΉ
Conversion of a product of three categories to products of two categories
βΊ
definition cf_cat_prod_21_of_3 :: "V β V β V β V"
where "cf_cat_prod_21_of_3 π π
β =
[
(Ξ»Aββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦. [[Aβ¦0β¦, Aβ¦1β©ββ¦]β©β, Aβ¦2β©ββ¦]β©β),
(Ξ»Fββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦. [[Fβ¦0β¦, Fβ¦1β©ββ¦]β©β, Fβ¦2β©ββ¦]β©β),
π Γβ©Cβ©3 π
Γβ©Cβ©3 β,
(π Γβ©C π
) Γβ©C β
]β©β"
definition cf_cat_prod_12_of_3 :: "V β V β V β V"
where "cf_cat_prod_12_of_3 π π
β =
[
(Ξ»Aββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦. [Aβ¦0β¦, [Aβ¦1β©ββ¦, Aβ¦2β©ββ¦]β©β]β©β),
(Ξ»Fββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦. [Fβ¦0β¦, [Fβ¦1β©ββ¦, Fβ¦2β©ββ¦]β©β]β©β),
π Γβ©Cβ©3 π
Γβ©Cβ©3 β,
π Γβ©C (π
Γβ©C β)
]β©β"
textβΉComponents.βΊ
lemma cf_cat_prod_21_of_3_components:
shows "cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦ =
(Ξ»Aββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦. [[Aβ¦0β¦, Aβ¦1β©ββ¦]β©β, Aβ¦2β©ββ¦]β©β)"
and "cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦ =
(Ξ»Fββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦. [[Fβ¦0β¦, Fβ¦1β©ββ¦]β©β, Fβ¦2β©ββ¦]β©β)"
and [cat_cs_simps]: "cf_cat_prod_21_of_3 π π
ββ¦HomDomβ¦ = π Γβ©Cβ©3 π
Γβ©Cβ©3 β"
and [cat_cs_simps]: "cf_cat_prod_21_of_3 π π
ββ¦HomCodβ¦ = (π Γβ©C π
) Γβ©C β"
unfolding cf_cat_prod_21_of_3_def dghm_field_simps
by (simp_all add: nat_omega_simps)
lemma cf_cat_prod_12_of_3_components:
shows "cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦ =
(Ξ»Aββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦. [Aβ¦0β¦, [Aβ¦1β©ββ¦, Aβ¦2β©ββ¦]β©β]β©β)"
and "cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦ =
(Ξ»Fββ©β(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦. [Fβ¦0β¦, [Fβ¦1β©ββ¦, Fβ¦2β©ββ¦]β©β]β©β)"
and [cat_cs_simps]: "cf_cat_prod_12_of_3 π π
ββ¦HomDomβ¦ = π Γβ©Cβ©3 π
Γβ©Cβ©3 β"
and [cat_cs_simps]: "cf_cat_prod_12_of_3 π π
ββ¦HomCodβ¦ = π Γβ©C (π
Γβ©C β)"
unfolding cf_cat_prod_12_of_3_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObjectβΊ
mk_VLambda cf_cat_prod_21_of_3_components(1)
|vsv cf_cat_prod_21_of_3_ObjMap_vsv[cat_cs_intros]|
|vdomain cf_cat_prod_21_of_3_ObjMap_vdomain[cat_cs_simps]|
|app cf_cat_prod_21_of_3_ObjMap_app'|
mk_VLambda cf_cat_prod_12_of_3_components(1)
|vsv cf_cat_prod_12_of_3_ObjMap_vsv[cat_cs_intros]|
|vdomain cf_cat_prod_12_of_3_ObjMap_vdomain[cat_cs_simps]|
|app cf_cat_prod_12_of_3_ObjMap_app'|
lemma cf_cat_prod_21_of_3_ObjMap_app[cat_cs_simps]:
assumes "A = [a, b, c]β©β" and "[a, b, c]β©β ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
shows "cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ = [[a, b]β©β, c]β©β"
using assms(2)
unfolding assms(1)
by (simp add: cf_cat_prod_21_of_3_ObjMap_app' nat_omega_simps)
lemma cf_cat_prod_12_of_3_ObjMap_app[cat_cs_simps]:
assumes "A = [a, b, c]β©β" and "[a, b, c]β©β ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
shows "cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ = [a, [b, c]β©β]β©β"
using assms(2)
unfolding assms(1)
by (simp add: cf_cat_prod_12_of_3_ObjMap_app' nat_omega_simps)
lemma cf_cat_prod_21_of_3_ObjMap_vrange:
assumes "category Ξ± π" and "category Ξ± π
" and "category Ξ± β"
shows "ββ©β (cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦) ββ©β ((π Γβ©C π
) Γβ©C β)β¦Objβ¦"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret β: category Ξ± β by (rule assms(3))
show ?thesis
proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_21_of_3_ObjMap_vdomain)
fix A assume prems: "A ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
then show "cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ ββ©β ((π Γβ©C π
) Γβ©C β)β¦Objβ¦"
by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed
lemma cf_cat_prod_12_of_3_ObjMap_vrange:
assumes "category Ξ± π" and "category Ξ± π
" and "category Ξ± β"
shows "ββ©β (cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦) ββ©β (π Γβ©C (π
Γβ©C β))β¦Objβ¦"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret β: category Ξ± β by (rule assms(3))
show ?thesis
proof(rule vsv.vsv_vrange_vsubset, unfold cf_cat_prod_12_of_3_ObjMap_vdomain)
fix A assume prems: "A ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦"
then show "cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ ββ©β (π Γβ©C (π
Γβ©C β))β¦Objβ¦"
by (elim cat_prod_3_ObjE[OF assms], insert prems, simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed
subsubsectionβΉArrowβΊ
mk_VLambda cf_cat_prod_21_of_3_components(2)
|vsv cf_cat_prod_21_of_3_ArrMap_vsv[cat_cs_intros]|
|vdomain cf_cat_prod_21_of_3_ArrMap_vdomain[cat_cs_simps]|
|app cf_cat_prod_21_of_3_ArrMap_app'|
mk_VLambda cf_cat_prod_12_of_3_components(2)
|vsv cf_cat_prod_12_of_3_ArrMap_vsv[cat_cs_intros]|
|vdomain cf_cat_prod_12_of_3_ArrMap_vdomain[cat_cs_simps]|
|app cf_cat_prod_12_of_3_ArrMap_app'|
lemma cf_cat_prod_21_of_3_ArrMap_app[cat_cs_simps]:
assumes "F = [h, g, f]β©β" and "[h, g, f]β©β ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦"
shows "cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦ = [[h, g]β©β, f]β©β"
using assms(2) unfolding assms(1)
by (simp add: cf_cat_prod_21_of_3_ArrMap_app' nat_omega_simps)
lemma cf_cat_prod_12_of_3_ArrMap_app[cat_cs_simps]:
assumes "F = [h, g, f]β©β" and "[h, g, f]β©β ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Arrβ¦"
shows "cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦ = [h, [g, f]β©β]β©β"
using assms(2)
unfolding assms(1)
by (simp add: cf_cat_prod_12_of_3_ArrMap_app' nat_omega_simps)
subsubsectionβΉ
Conversion of a product of three categories to products
of two categories is a functor
βΊ
lemma cf_cat_prod_21_of_3_is_functor:
assumes "category Ξ± π" and "category Ξ± π
" and "category Ξ± β"
shows "cf_cat_prod_21_of_3 π π
β : π Γβ©Cβ©3 π
Γβ©Cβ©3 β β¦β¦β©CβΞ±β (π Γβ©C π
) Γβ©C β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret β: category Ξ± β by (rule assms(3))
show ?thesis
proof(rule is_functorI')
show "vfsequence (cf_cat_prod_21_of_3 π π
β)"
unfolding cf_cat_prod_21_of_3_def by auto
show "vcard (cf_cat_prod_21_of_3 π π
β) = 4β©β"
unfolding cf_cat_prod_21_of_3_def by (simp add: nat_omega_simps)
show "ββ©β (cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦) ββ©β ((π Γβ©C π
) Γβ©C β)β¦Objβ¦"
by (rule cf_cat_prod_21_of_3_ObjMap_vrange[OF assms])
show
"cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦ :
cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ β¦β(π Γβ©C π
) Γβ©C ββ
cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦β¦Bβ¦"
if "F : A β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ B"
for A B F
using that
by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
show
"cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦G ββ©Aβπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ Fβ¦ =
cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦Gβ¦ ββ©Aβ(π Γβ©C π
) Γβ©C ββ
cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦"
if "G : B β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ C" and "F : A β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ B"
for B C G A F
proof-
from that(2) obtain f f' f'' a a' a'' b b' b''
where F_def: "F = [f, f', f'']β©β"
and A_def: "A = [a, a', a'']β©β"
and B_def: "B = [b, b', b'']β©β"
and f: "f : a β¦βπβ b"
and f': "f' : a' β¦βπ
β b'"
and f'': "f'' : a'' β¦βββ b''"
by (elim cat_prod_3_is_arrE[OF assms])
with that(1) obtain g g' g'' c c' c''
where G_def: "G = [g, g', g'']β©β"
and C_def: "C = [c, c', c'']β©β"
and g: "g : b β¦βπβ c"
and g': "g' : b' β¦βπ
β c'"
and g'': "g'' : b'' β¦βββ c''"
by (auto elim: cat_prod_3_is_arrE[OF assms])
from that f f' f'' g g' g'' show ?thesis
unfolding F_def A_def B_def G_def C_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"cf_cat_prod_21_of_3 π π
ββ¦ArrMapβ¦β¦(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦β¦Cβ¦β¦ =
((π Γβ©C π
) Γβ©C β)β¦CIdβ¦β¦cf_cat_prod_21_of_3 π π
ββ¦ObjMapβ¦β¦Cβ¦β¦"
if "C ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦" for C
using that
by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma cf_cat_prod_21_of_3_is_functor'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "category Ξ± β"
and "π' = π Γβ©Cβ©3 π
Γβ©Cβ©3 β"
and "π
' = (π Γβ©C π
) Γβ©C β"
shows "cf_cat_prod_21_of_3 π π
β : π' β¦β¦β©CβΞ±β π
'"
using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_21_of_3_is_functor)
lemma cf_cat_prod_12_of_3_is_functor:
assumes "category Ξ± π" and "category Ξ± π
" and "category Ξ± β"
shows "cf_cat_prod_12_of_3 π π
β : π Γβ©Cβ©3 π
Γβ©Cβ©3 β β¦β¦β©CβΞ±β π Γβ©C (π
Γβ©C β)"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret β: category Ξ± β by (rule assms(3))
show ?thesis
proof(rule is_functorI')
show "vfsequence (cf_cat_prod_12_of_3 π π
β)"
unfolding cf_cat_prod_12_of_3_def by auto
show "vcard (cf_cat_prod_12_of_3 π π
β) = 4β©β"
unfolding cf_cat_prod_12_of_3_def by (simp add: nat_omega_simps)
show "ββ©β (cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦) ββ©β (π Γβ©C (π
Γβ©C β))β¦Objβ¦"
by (rule cf_cat_prod_12_of_3_ObjMap_vrange[OF assms])
show
"cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦ :
cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦β¦Aβ¦ β¦βπ Γβ©C (π
Γβ©C β)β
cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦β¦Bβ¦"
if "F : A β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ B"
for A B F
using that
by (elim cat_prod_3_is_arrE[OF assms], insert that, simp only:)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
show
"cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦G ββ©Aβπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ Fβ¦ =
cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦Gβ¦ ββ©Aβπ Γβ©C (π
Γβ©C β)β
cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦Fβ¦"
if "G : B β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ C" and "F : A β¦βπ Γβ©Cβ©3 π
Γβ©Cβ©3 ββ B"
for B C G A F
proof-
from that(2) obtain f f' f'' a a' a'' b b' b''
where F_def: "F = [f, f', f'']β©β"
and A_def: "A = [a, a', a'']β©β"
and B_def: "B = [b, b', b'']β©β"
and f: "f : a β¦βπβ b"
and f': "f' : a' β¦βπ
β b'"
and f'': "f'' : a'' β¦βββ b''"
by (elim cat_prod_3_is_arrE[OF assms])
with that(1) obtain g g' g'' c c' c''
where G_def: "G = [g, g', g'']β©β"
and C_def: "C = [c, c', c'']β©β"
and g: "g : b β¦βπβ c"
and g': "g' : b' β¦βπ
β c'"
and g'': "g'' : b'' β¦βββ c''"
by (auto elim: cat_prod_3_is_arrE[OF assms])
from that f f' f'' g g' g'' show ?thesis
unfolding F_def A_def B_def G_def C_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"cf_cat_prod_12_of_3 π π
ββ¦ArrMapβ¦β¦(π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦CIdβ¦β¦Cβ¦β¦ =
(π Γβ©C (π
Γβ©C β))β¦CIdβ¦β¦cf_cat_prod_12_of_3 π π
ββ¦ObjMapβ¦β¦Cβ¦β¦"
if "C ββ©β (π Γβ©Cβ©3 π
Γβ©Cβ©3 β)β¦Objβ¦" for C
using that
by (elim cat_prod_3_ObjE[OF assms], insert that, simp only: )
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma cf_cat_prod_12_of_3_is_functor'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "category Ξ± β"
and "π' = π Γβ©Cβ©3 π
Γβ©Cβ©3 β"
and "π
' = π Γβ©C (π
Γβ©C β)"
shows "cf_cat_prod_12_of_3 π π
β : π' β¦β¦β©CβΞ±β π
'"
using assms(1-3) unfolding assms(4,5) by (rule cf_cat_prod_12_of_3_is_functor)
subsectionβΉBifunctorsβΊ
textβΉ
A bifunctor is defined as a functor from a product of two categories
to a category (see Chapter II-3 in \cite{mac_lane_categories_2010}).
This subsection exposes the elementary properties of the projections of the
bifunctors established by fixing an argument in a functor (see Chapter II-3
in \cite{mac_lane_categories_2010} for further information).
βΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
definition bifunctor_proj_fst :: "V β V β V β V β V"
(βΉ(_β_,_β/'(/-,_/')/β©Cβ©F)βΊ [51, 51, 51, 51] 51)
where "πβπ,π
β(-,b)β©Cβ©F =
(πβββ©Ciββ©β2β©β -β©β set {1β©β}. (i = 0 ? π : π
),πβ¦HomCodβ¦β(-,set {β¨1β©β, bβ©})) ββ©Cβ©F
cf_singleton 0 π"
definition bifunctor_proj_snd :: "V β V β V β V β V"
(βΉ(_β_,_β/'(/_,-/')/β©Cβ©F)βΊ [51, 51, 51, 51] 51)
where "πβπ,π
β(a,-)β©Cβ©F =
(πβββ©Ciββ©β2β©β -β©β set {0}. (i = 0 ? π : π
),πβ¦HomCodβ¦β(-,set {β¨0, aβ©})) ββ©Cβ©F
cf_singleton (1β©β) π
"
abbreviation bcf_ObjMap_app :: "V β V β V β V" (infixl "ββ©Hβ©Mβ©.β©OΔ±" 55)
where "a ββ©Hβ©Mβ©.β©Oβπβ b β‘ πβ¦ObjMapβ¦β¦a, bβ¦β©β"
abbreviation bcf_ArrMap_app :: "V β V β V β V" (infixl "ββ©Hβ©Mβ©.β©AΔ±" 55)
where "g ββ©Hβ©Mβ©.β©Aβπβ f β‘ πβ¦ArrMapβ¦β¦g, fβ¦β©β"
textβΉElementary properties.βΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemma cat_singleton_qm_fst_def[simp]:
"(ββ©Ciββ©βset {0}. (i = 0 ? π : π
)) = (ββ©Ciββ©βset {0}. π)"
proof(rule cat_eqI[of Ξ±])
show "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Objβ¦ = (ββ©Ciββ©βset {0}. π)β¦Objβ¦"
unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
show [simp]: "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Arrβ¦ = (ββ©Ciββ©βset {0}. π)β¦Arrβ¦"
unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
show [simp]: "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Domβ¦ = (ββ©Ciββ©βset {0}. π)β¦Domβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
show [simp]:
"(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Codβ¦ = (ββ©Ciββ©βset {0}. π)β¦Codβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
have [simp]:
"f : a β¦βββ©Ciββ©βset {0}. (i = 0 ? π : π
)β b β·
f : a β¦βββ©Ciββ©βset {0}. πβ b"
for f a b
unfolding is_arr_def by simp
show "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Compβ¦ = (ββ©Ciββ©βset {0}. π)β¦Compβ¦"
proof(rule vsv_eqI)
show "vsv ((ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Compβ¦)"
unfolding cat_prod_components by simp
show "vsv ((ββ©Ciββ©βset {0}. π)β¦Compβ¦)"
unfolding cat_prod_components by simp
show "πβ©β ((ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Compβ¦) =
πβ©β ((ββ©Ciββ©βset {0}. π)β¦Compβ¦)"
by (simp add: composable_arrs_def cat_cs_simps)
show "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Compβ¦β¦gfβ¦ =
(ββ©Ciββ©βset {0}. π)β¦Compβ¦β¦gfβ¦"
if "gf ββ©β πβ©β ((ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦Compβ¦)" for gf
proof-
from that have "gf ββ©β composable_arrs (ββ©Ciββ©βset {0}. (i = 0 ? π : π
))"
by (simp add: cat_cs_simps)
then obtain g f a b c where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦β(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β c"
and f: "f : a β¦β(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β b"
by clarsimp
then have g': "g : b β¦β(ββ©Ciββ©βset {0}. π)β c"
and f': "f : a β¦β(ββ©Ciββ©βset {0}. π)β b"
by simp_all
show ?thesis
unfolding gf_def
unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
by (subst (1 2) VLambda_vsingleton_def) simp
qed
qed
show "(ββ©Ciββ©βset {0}. (i = 0 ? π : π
))β¦CIdβ¦ = (ββ©Ciββ©βset {0}. π)β¦CIdβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
qed
(
simp_all add:
π.cat_category_cat_singleton
pcategory.pcat_category_cat_prod
pcat_vsubset_index_pcategory
vsubset_vsingleton_leftI
)
lemma cat_singleton_qm_snd_def[simp]:
"(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
)) = (ββ©Ciββ©βset {1β©β}. π
)"
proof(rule cat_eqI[of Ξ±])
show "(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Objβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦Objβ¦"
unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
show [simp]:
"(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Arrβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦Arrβ¦"
unfolding cat_prod_components by (subst vproduct_vsingleton_def) simp
show [simp]:
"(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Domβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦Domβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
show [simp]:
"(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Codβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦Codβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
have [simp]: "f : a β¦βββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
)β b β·
f : a β¦βββ©Ciββ©βset {1β©β}. π
β b"
for f a b
unfolding is_arr_def by simp
show "(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Compβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦Compβ¦"
proof(rule vsv_eqI)
show "vsv ((ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Compβ¦)"
unfolding cat_prod_components by simp
show "vsv ((ββ©Ciββ©βset {1β©β}. π
)β¦Compβ¦)"
unfolding cat_prod_components by simp
show "πβ©β ((ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Compβ¦) =
πβ©β ((ββ©Ciββ©βset {1β©β}. π
)β¦Compβ¦)"
by (simp add: composable_arrs_def cat_cs_simps)
show "(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Compβ¦β¦gfβ¦ =
(ββ©Ciββ©βset {1β©β}. π
)β¦Compβ¦β¦gfβ¦"
if "gf ββ©β πβ©β ((ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦Compβ¦)" for gf
proof-
from that have "gf ββ©β composable_arrs (ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))"
by (simp add: cat_cs_simps)
then obtain g f a b c where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦β(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β c"
and f: "f : a β¦β(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β b"
by clarsimp
then have g': "g : b β¦β(ββ©Ciββ©βset {1β©β}. π
)β c"
and f': "f : a β¦β(ββ©Ciββ©βset {1β©β}. π
)β b"
by simp_all
show ?thesis
unfolding gf_def
unfolding cat_prod_Comp_app[OF g f] cat_prod_Comp_app[OF g' f']
by (subst (1 2) VLambda_vsingleton_def) simp
qed
qed
show "(ββ©Ciββ©βset {1β©β}. (i = 0 ? π : π
))β¦CIdβ¦ = (ββ©Ciββ©βset {1β©β}. π
)β¦CIdβ¦"
unfolding cat_prod_components
by (subst vproduct_vsingleton_def, subst (1 2) VLambda_vsingleton_def) simp
qed
(
simp_all add:
π
.cat_category_cat_singleton
pcategory.pcat_category_cat_prod
pcat_vsubset_index_pcategory
vsubset_vsingleton_leftI
)
end
subsubsectionβΉObject mapβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemmas_with [OF π.category_axioms π
.category_axioms, simp]:
cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
lemma bifunctor_proj_fst_ObjMap_app[cat_cs_simps]:
assumes "[a, b]β©β ββ©β (π Γβ©C π
)β¦Objβ¦"
shows "(πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
proof-
let ?π = βΉπβ¦HomCodβ¦βΊ
let ?π = βΉπβββ©Ciββ©β2β©β-β©βset {1β©β}.(i = 0 ? π : π
),?πβ(-,set {β¨1β©β, bβ©})βΊ
let ?cfs = βΉcf_singleton 0 πβΊ
from assms have a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (allβΉelim cat_prod_2_ObjE[OF π π
]βΊ) auto
from a have za: "set {β¨0, aβ©} ββ©β (ββ©Ciββ©βset {0}. π)β¦Objβ¦"
by (intro cat_singleton_ObjI[where a=a]) simp
have [simp]: "vinsert β¨0, aβ© (set {β¨1β©β, bβ©}) = [a, b]β©β"
using ord_of_nat_succ_vempty unfolding vcons_def by auto
have "(πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ = (?πβ¦ObjMapβ¦ ββ©β ?cfsβ¦ObjMapβ¦)β¦aβ¦"
unfolding bifunctor_proj_fst_def dghm_comp_components by simp
also have "β¦ = ?πβ¦ObjMapβ¦β¦?cfsβ¦ObjMapβ¦β¦aβ¦β¦"
by (rule vsv_vcomp_at)
(
simp_all add:
two a za
cf_singleton_components
prodfunctor_proj_components
cf_singleton_ObjMap_app
)
also from za have "β¦ = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
unfolding two cf_singleton_ObjMap_app[OF a] prodfunctor_proj_components
by simp
finally show ?thesis by simp
qed
lemma bifunctor_proj_snd_ObjMap_app[cat_cs_simps]:
assumes "[a, b]β©β ββ©β (π Γβ©C π
)β¦Objβ¦"
shows "(πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦ = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
proof-
let ?π = βΉπβ¦HomCodβ¦βΊ
let ?π = βΉπβββ©Ciββ©β2β©β-β©βset {0}.(i = 0 ? π : π
),?πβ(-,set {β¨0, aβ©})βΊ
let ?cfs = βΉcf_singleton (1β©β) π
βΊ
from assms have a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (allβΉelim cat_prod_2_ObjE[OF π π
]βΊ) auto
from a have za: "set {β¨0, aβ©} ββ©β (ββ©Ciββ©βset {0}. π)β¦Objβ¦"
by (intro cat_singleton_ObjI[where a=a]) simp
from b have ob: "set {β¨1β©β, bβ©} ββ©β (ββ©Ciββ©βset {1β©β}. π
)β¦Objβ¦"
by (intro cat_singleton_ObjI[where a=b]) simp
have[simp]: "vinsert β¨1β©β, bβ© (set {β¨0, aβ©}) = [a, b]β©β"
using ord_of_nat_succ_vempty unfolding vcons_def by auto
have "(πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦ = (?πβ¦ObjMapβ¦ ββ©β ?cfsβ¦ObjMapβ¦)β¦bβ¦"
unfolding bifunctor_proj_snd_def dghm_comp_components by simp
also have "β¦ = ?πβ¦ObjMapβ¦β¦?cfsβ¦ObjMapβ¦β¦bβ¦β¦"
by (rule vsv_vcomp_at)
(
simp_all add:
two
cf_singleton_components
prodfunctor_proj_components
cf_singleton_ObjMap_app
ob b
)
also from ob have "β¦ = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
unfolding two cf_singleton_ObjMap_app[OF b] prodfunctor_proj_components
by simp
finally show ?thesis by simp
qed
end
subsubsectionβΉArrow mapβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemmas_with [OF π.category_axioms π
.category_axioms, simp]:
cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
lemma bifunctor_proj_fst_ArrMap_app[cat_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦" and "f ββ©β πβ¦Arrβ¦"
shows "(πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ = πβ¦ArrMapβ¦β¦f, π
β¦CIdβ¦β¦bβ¦β¦β©β"
proof-
let ?π = βΉπβ¦HomCodβ¦βΊ
let ?π = βΉπβββ©Ciββ©β2β©β-β©βset {1β©β}.(i = 0 ? π : π
),?πβ(-,set {β¨1β©β, bβ©})βΊ
let ?cfs = βΉcf_singleton 0 πβΊ
from assms(1) have "π
β¦CIdβ¦β¦bβ¦ : b β¦βπ
β b" by (auto intro: cat_cs_intros)
then have CId_b: "π
β¦CIdβ¦β¦bβ¦ ββ©β π
β¦Arrβ¦" by auto
from assms(2) have zf: "set {β¨0, fβ©} ββ©β (ββ©Ciββ©βset {0}. π)β¦Arrβ¦"
by (intro cat_singleton_ArrI[where a=f]) simp
from assms(1) have ob: "set {β¨1β©β, bβ©} ββ©β (ββ©Ciββ©βset {1β©β}. π
)β¦Objβ¦"
by (intro cat_singleton_ObjI[where a=b]) simp
have [simp]: "vinsert β¨0, fβ© (set {β¨1β©β, π
β¦CIdβ¦β¦bβ¦β©}) = [f, π
β¦CIdβ¦β¦bβ¦]β©β"
using ord_of_nat_succ_vempty unfolding vcons_def by auto
have "(πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ = (?πβ¦ArrMapβ¦ ββ©β ?cfsβ¦ArrMapβ¦)β¦fβ¦"
unfolding bifunctor_proj_fst_def dghm_comp_components by simp
also have "β¦ = ?πβ¦ArrMapβ¦β¦?cfsβ¦ArrMapβ¦β¦fβ¦β¦"
by (rule vsv_vcomp_at)
(
simp_all add:
two
assms(2)
cf_singleton_components
prodfunctor_proj_components
cf_singleton_ArrMap_app
zf
)
also from assms(1) zf have "β¦ = πβ¦ArrMapβ¦β¦f, π
β¦CIdβ¦β¦bβ¦β¦β©β"
unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components
by (simp add: two cat_singleton_CId_app[OF ob])
finally show ?thesis by simp
qed
lemma bifunctor_proj_snd_ArrMap_app[cat_cs_simps]:
assumes "a ββ©β πβ¦Objβ¦" and "g ββ©β π
β¦Arrβ¦"
shows "(πβπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦β¦gβ¦ = πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦aβ¦, gβ¦β©β"
proof-
let ?π = βΉπβ¦HomCodβ¦βΊ
let ?π = βΉπβββ©Ciββ©β2β©β-β©βset {0}.(i = 0 ? π : π
),?πβ(-,set {β¨0, aβ©})βΊ
let ?cfs = βΉcf_singleton (1β©β) π
βΊ
from assms(1) have "πβ¦CIdβ¦β¦aβ¦ : a β¦βπβ a" by (auto intro: cat_cs_intros)
then have CId_a: "πβ¦CIdβ¦β¦aβ¦ ββ©β πβ¦Arrβ¦" by auto
from assms(2) have og: "set {β¨1β©β, gβ©} ββ©β (ββ©Ciββ©βset {1β©β}. π
)β¦Arrβ¦"
by (intro cat_singleton_ArrI[where a=g]) simp
from assms(1) have ob: "set {β¨0, aβ©} ββ©β (ββ©Ciββ©βset {0}. π)β¦Objβ¦"
by (intro cat_singleton_ObjI[where a=a]) simp
have [simp]: "vinsert β¨1β©β, gβ© (set {β¨0, πβ¦CIdβ¦β¦aβ¦β©}) = [πβ¦CIdβ¦β¦aβ¦, g]β©β"
using ord_of_nat_succ_vempty unfolding vcons_def by auto
have "(πβπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦β¦gβ¦ = (?πβ¦ArrMapβ¦ ββ©β ?cfsβ¦ArrMapβ¦)β¦gβ¦"
unfolding two bifunctor_proj_snd_def dghm_comp_components by simp
also have "β¦ = ?πβ¦ArrMapβ¦β¦?cfsβ¦ArrMapβ¦β¦gβ¦β¦"
by (rule vsv_vcomp_at)
(
simp_all add:
two
assms(2)
cf_singleton_components
prodfunctor_proj_components
cf_singleton_ArrMap_app
og
)
also from assms(1) og have "β¦ = πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦aβ¦, gβ¦β©β"
unfolding cf_singleton_ArrMap_app[OF assms(2)] prodfunctor_proj_components
by (simp add: two cat_singleton_CId_app[OF ob])
finally show ?thesis by simp
qed
end
subsubsectionβΉBifunctor projections are functorsβΊ
context
fixes Ξ± π π
assumes π: "category Ξ± π" and π
: "category Ξ± π
"
begin
interpretation π: category Ξ± π by (rule π)
interpretation π
: category Ξ± π
by (rule π
)
interpretation finite_pcategory Ξ± βΉ2β©ββΊ βΉif2 π π
βΊ
by (intro finite_pcategory_cat_prod_2 π π
)
lemmas_with [OF π.category_axioms π
.category_axioms, simp]:
cat_singleton_qm_fst_def and cat_singleton_qm_snd_def
lemma bifunctor_proj_fst_is_functor:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦"
shows "πβπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ π π by (rule assms(1))
show ?thesis
unfolding bifunctor_proj_fst_def
proof
(
intro cf_comp_is_functorI[where π
=βΉ(ββ©Ciββ©βset {0}. π)βΊ],
unfold π.cf_HomCod
)
from assms(2) have zb:
"set {β¨1β©β, bβ©} ββ©β (ββ©Cjββ©βset {1β©β}. if j = 0 then π else π
)β¦Objβ¦"
unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
have o_zo: "set {1β©β} ββ©β 2β©β" by clarsimp
from pcat_prodfunctor_proj_is_functor[
folded cat_prod_2_def, where J=βΉset {1β©β}βΊ, OF assms(1) zb o_zo
]
show "πβββ©Ciββ©β2β©β-β©βset {1β©β}.(i = 0 ? π : π
),πβ(-,set {β¨1β©β, bβ©}) :
(ββ©Ciββ©βset {0}. π) β¦β¦β©CβΞ±β π"
unfolding two by simp
from category.cat_cf_singleton_is_functor[OF π.category_axioms, of 0] show
"cf_singleton 0 π : π β¦β¦β©CβΞ±β (ββ©Ciββ©βset {0}. π)"
by force
qed
qed
lemma bifunctor_proj_fst_is_functor'[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦" and "π' = π"
shows "πβπ,π
β(-,b)β©Cβ©F : π' β¦β¦β©CβΞ±β π"
using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_fst_is_functor)
lemma bifunctor_proj_fst_ObjMap_vsv[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦"
shows "vsv ((πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦)"
proof-
interpret π: is_functor Ξ± π π βΉπβπ,π
β(-,b)β©Cβ©FβΊ
by (rule bifunctor_proj_fst_is_functor[OF assms])
show ?thesis by (rule π.cf_ObjMap_vsv)
qed
lemma bifunctor_proj_fst_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦"
shows "πβ©β ((πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦) = πβ¦Objβ¦"
proof-
interpret π: is_functor Ξ± π π βΉπβπ,π
β(-,b)β©Cβ©FβΊ
by (rule bifunctor_proj_fst_is_functor[OF assms])
show ?thesis by (rule π.cf_ObjMap_vdomain)
qed
lemma bifunctor_proj_fst_ArrMap_vsv[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦"
shows "vsv ((πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦)"
proof-
interpret π: is_functor Ξ± π π βΉπβπ,π
β(-,b)β©Cβ©FβΊ
by (rule bifunctor_proj_fst_is_functor[OF assms])
show ?thesis by (rule π.cf_ArrMap_vsv)
qed
lemma bifunctor_proj_fst_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "b ββ©β π
β¦Objβ¦"
shows "πβ©β ((πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦) = πβ¦Arrβ¦"
proof-
interpret π: is_functor Ξ± π π βΉπβπ,π
β(-,b)β©Cβ©FβΊ
by (rule bifunctor_proj_fst_is_functor[OF assms])
show ?thesis by (rule π.cf_ArrMap_vdomain)
qed
lemma bifunctor_proj_snd_is_functor:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦"
shows "πβπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ π π by (rule assms(1))
show ?thesis
unfolding bifunctor_proj_snd_def
proof
(
intro cf_comp_is_functorI[where π
=βΉ(ββ©Ciββ©βset {1β©β}. π
)βΊ],
unfold π.cf_HomCod
)
from assms(2) have zb:
"set {β¨0, aβ©} ββ©β (ββ©Cjββ©βset {0}. if j = 0 then π else π
)β¦Objβ¦"
unfolding cat_prod_components by (intro vproduct_vsingletonI) simp_all
have o_zo: "set {0} ββ©β 2β©β" by clarsimp
from
pcat_prodfunctor_proj_is_functor[
folded cat_prod_2_def, where J=βΉset {0}βΊ, OF assms(1) zb o_zo
]
show "πβββ©Ciββ©β2β©β-β©βset {0}.(i = 0 ? π : π
),πβ(-,set {β¨0, aβ©}) :
(ββ©Ciββ©βset {1β©β}. π
) β¦β¦β©CβΞ±β π"
unfolding two by simp
from category.cat_cf_singleton_is_functor[OF π
.category_axioms, of βΉ1β©ββΊ]
show "cf_singleton (1β©β) π
: π
β¦β¦β©CβΞ±β (ββ©Ciββ©βset {1β©β}. π
)"
by force
qed
qed
lemma bifunctor_proj_snd_is_functor'[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦" and "π
' = π
"
shows "πβπ,π
β(a,-)β©Cβ©F : π
' β¦β¦β©CβΞ±β π"
using assms(1,2) unfolding assms(3) by (rule bifunctor_proj_snd_is_functor)
lemma bifunctor_proj_snd_ObjMap_vsv[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦"
shows "vsv ((πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦)"
proof-
interpret π: is_functor Ξ± π
π βΉπβπ,π
β(a,-)β©Cβ©FβΊ
by (rule bifunctor_proj_snd_is_functor[OF assms])
show ?thesis by (rule π.cf_ObjMap_vsv)
qed
lemma bifunctor_proj_snd_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦"
shows "πβ©β ((πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦) = π
β¦Objβ¦"
proof-
interpret π: is_functor Ξ± π
π βΉπβπ,π
β(a,-)β©Cβ©FβΊ
by (rule bifunctor_proj_snd_is_functor[OF assms])
show ?thesis by (rule π.cf_ObjMap_vdomain)
qed
lemma bifunctor_proj_snd_ArrMap_vsv[cat_cs_intros]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦"
shows "vsv ((πβπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦)"
proof-
interpret π: is_functor Ξ± π
π βΉπβπ,π
β(a,-)β©Cβ©FβΊ
by (rule bifunctor_proj_snd_is_functor[OF assms])
show ?thesis by (rule π.cf_ArrMap_vsv)
qed
lemma bifunctor_proj_snd_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π Γβ©C π
β¦β¦β©CβΞ±β π" and "a ββ©β πβ¦Objβ¦"
shows "πβ©β ((πβπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦) = π
β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± π
π βΉπβπ,π
β(a,-)β©Cβ©FβΊ
by (rule bifunctor_proj_snd_is_functor[OF assms])
show ?thesis by (rule π.cf_ArrMap_vdomain)
qed
end
subsectionβΉBifunctor flipβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition bifunctor_flip :: "V β V β V β V"
where "bifunctor_flip π π
π =
[fflip (πβ¦ObjMapβ¦), fflip (πβ¦ArrMapβ¦), π
Γβ©C π, πβ¦HomCodβ¦]β©β"
textβΉComponentsβΊ
lemma bifunctor_flip_components:
shows "bifunctor_flip π π
πβ¦ObjMapβ¦ = fflip (πβ¦ObjMapβ¦)"
and "bifunctor_flip π π
πβ¦ArrMapβ¦ = fflip (πβ¦ArrMapβ¦)"
and "bifunctor_flip π π
πβ¦HomDomβ¦ = π
Γβ©C π"
and "bifunctor_flip π π
πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding bifunctor_flip_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉBifunctor flip object mapβΊ
lemma bifunctor_flip_ObjMap_vsv[cat_cs_intros]:
"vsv (bifunctor_flip π π
πβ¦ObjMapβ¦)"
unfolding bifunctor_flip_components by (rule fflip_vsv)
lemma bifunctor_flip_ObjMap_app:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "bifunctor_flip π π
πβ¦ObjMapβ¦β¦b, aβ¦β©β = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
using assms
unfolding bifunctor_flip_components assms(4,5)
by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
lemma bifunctor_flip_ObjMap_app'[cat_cs_simps]:
assumes "ba = [b, a]β©β"
and "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ = πβ¦ObjMapβ¦β¦a, bβ¦β©β"
using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ObjMap_app)
lemma bifunctor_flip_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "πβ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) = (π
Γβ©C π)β¦Objβ¦"
using assms
unfolding bifunctor_flip_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
lemma bifunctor_flip_ObjMap_vrange[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) = ββ©β (πβ¦ObjMapβ¦)"
proof-
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ β π by (rule assms(3))
show ?thesis
proof(intro vsubset_antisym)
show "ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) ββ©β ββ©β (πβ¦ObjMapβ¦)"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold bifunctor_flip_ObjMap_vdomain[OF assms]
)
fix ba assume "ba ββ©β (π
Γβ©C π)β¦Objβ¦"
then obtain a b
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(2,1)])
from assms a b show
"bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ ββ©β ββ©β (πβ¦ObjMapβ¦)"
unfolding ba_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
)
qed (auto intro: cat_cs_intros)
show "ββ©β (πβ¦ObjMapβ¦) ββ©β ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦)"
proof(intro vsv.vsv_vrange_vsubset, unfold π.cf_ObjMap_vdomain)
fix ab assume prems: "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
from assms a b have ba: "[b, a]β©β ββ©β (π
Γβ©C π)β¦Objβ¦"
by (cs_concl cs_intro: cat_prod_cs_intros)
from assms bifunctor_flip_ObjMap_vsv prems a b ba show
"πβ¦ObjMapβ¦β¦abβ¦ ββ©β ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦)"
by (cs_concl cs_simp: ab_def cat_cs_simps cs_intro: V_cs_intros)
qed auto
qed
qed
subsubsectionβΉBifunctor flip arrow mapβΊ
lemma bifunctor_flip_ArrMap_vsv[cat_cs_intros]:
"vsv (bifunctor_flip π π
πβ¦ArrMapβ¦)"
unfolding bifunctor_flip_components by (rule fflip_vsv)
lemma bifunctor_flip_ArrMap_app:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "g ββ©β πβ¦Arrβ¦"
and "f ββ©β π
β¦Arrβ¦"
shows "bifunctor_flip π π
πβ¦ArrMapβ¦β¦f, gβ¦β©β = πβ¦ArrMapβ¦β¦g, fβ¦β©β"
using assms
unfolding bifunctor_flip_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
lemma bifunctor_flip_ArrMap_app'[cat_cs_simps]:
assumes "fg = [f, g]β©β"
and "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "g ββ©β πβ¦Arrβ¦"
and "f ββ©β π
β¦Arrβ¦"
shows "bifunctor_flip π π
πβ¦ArrMapβ¦β¦fgβ¦ = πβ¦ArrMapβ¦β¦g, fβ¦β©β"
using assms(2-6) unfolding assms(1) by (rule bifunctor_flip_ArrMap_app)
lemma bifunctor_flip_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "πβ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) = (π
Γβ©C π)β¦Arrβ¦"
using assms
unfolding bifunctor_flip_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
lemma bifunctor_flip_ArrMap_vrange[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) = ββ©β (πβ¦ArrMapβ¦)"
proof-
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ β π by (rule assms(3))
show ?thesis
proof(intro vsubset_antisym)
show "ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) ββ©β ββ©β (πβ¦ArrMapβ¦)"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold bifunctor_flip_ArrMap_vdomain[OF assms]
)
fix fg assume "fg ββ©β (π
Γβ©C π)β¦Arrβ¦"
then obtain f g
where fg_def: "fg = [f, g]β©β"
and f: "f ββ©β π
β¦Arrβ¦"
and g: "g ββ©β πβ¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF assms(2,1)])
from f obtain a b where f: "f : a β¦βπ
β b" by (auto intro: is_arrI)
from g obtain a' b' where g: "g : a' β¦βπβ b'" by (auto intro: is_arrI)
from π.cf_ArrMap_vsv assms f g show
"bifunctor_flip π π
πβ¦ArrMapβ¦β¦fgβ¦ ββ©β ββ©β (πβ¦ArrMapβ¦)"
unfolding fg_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_prod_cs_intros
)
qed (auto intro: cat_cs_intros)
show "ββ©β (πβ¦ArrMapβ¦) ββ©β ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦)"
proof(intro vsv.vsv_vrange_vsubset, unfold π.cf_ArrMap_vdomain)
fix gf assume prems: "gf ββ©β (π Γβ©C π
)β¦Arrβ¦"
then obtain g f
where gf_def: "gf = [g, f]β©β"
and g: "g ββ©β πβ¦Arrβ¦"
and f: "f ββ©β π
β¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF assms(1,2)])
from assms g f have fg: "[f, g]β©β ββ©β (π
Γβ©C π)β¦Arrβ¦"
by (cs_concl cs_intro: cat_prod_cs_intros)
from assms bifunctor_flip_ArrMap_vsv prems g f fg show
"πβ¦ArrMapβ¦β¦gfβ¦ ββ©β ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦)"
unfolding gf_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
qed auto
qed
qed
subsubsectionβΉBifunctor flip is a bifunctorβΊ
lemma bifunctor_flip_is_functor:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "bifunctor_flip π π
π : π
Γβ©C π β¦β¦β©CβΞ±β β "
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ β π by (rule assms)
show ?thesis
proof(intro is_functorI')
show "vfsequence (bifunctor_flip π π
π)"
unfolding bifunctor_flip_def by simp
from assms(1,2) show "category Ξ± (π
Γβ©C π)"
by (cs_concl cs_intro: cat_cs_intros)
show "vcard (bifunctor_flip π π
π) = 4β©β"
unfolding bifunctor_flip_def by (simp add: nat_omega_simps)
show "vsv (bifunctor_flip π π
πβ¦ObjMapβ¦)" by (auto intro: cat_cs_intros)
show "vsv (bifunctor_flip π π
πβ¦ArrMapβ¦)" by (auto intro: cat_cs_intros)
from assms show "πβ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) = (π
Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms π.cf_ObjMap_vrange show
"ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms show "πβ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) = (π
Γβ©C π)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "bifunctor_flip π π
πβ¦ArrMapβ¦β¦gfβ¦ :
bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ β¦βββ
bifunctor_flip π π
πβ¦ObjMapβ¦β¦b'a'β¦"
if "gf : ba β¦βπ
Γβ©C πβ b'a'" for ba b'a' gf
proof-
from that obtain g f a b a' b'
where gf_def: "gf = [g, f]β©β"
and ba_def: "ba = [b, a]β©β"
and b'a'_def: "b'a' = [b', a']β©β"
and g: "g : b β¦βπ
β b'"
and f: "f : a β¦βπβ a'"
by (elim cat_prod_2_is_arrE[OF assms(2,1)])
from assms g f show ?thesis
unfolding gf_def ba_def b'a'_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"bifunctor_flip π π
πβ¦ArrMapβ¦β¦gg' ββ©Aβπ
Γβ©C πβ ff'β¦ =
bifunctor_flip π π
πβ¦ArrMapβ¦β¦gg'β¦ ββ©Aβββ
bifunctor_flip π π
πβ¦ArrMapβ¦β¦ff'β¦"
if gg': "gg' : bb' β¦βπ
Γβ©C πβ cc'" and ff': "ff' : aa' β¦βπ
Γβ©C πβ bb'"
for bb' cc' gg' aa' ff'
proof-
obtain g g' b b' c c'
where gg'_def: "gg' = [g, g']β©β"
and bb'_def: "bb' = [b, b']β©β"
and cc'_def: "cc' = [c, c']β©β"
and g: "g : b β¦βπ
β c"
and g': "g' : b' β¦βπβ c'"
by (elim cat_prod_2_is_arrE[OF assms(2,1) gg'])
moreover obtain f f' a a' b'' b'''
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and "bb' = [b'', b''']β©β"
and "f : a β¦βπ
β b''"
and "f' : a' β¦βπβ b'''"
by (elim cat_prod_2_is_arrE[OF assms(2,1) ff'])
ultimately have f: "f : a β¦βπ
β b" and f': "f' : a' β¦βπβ b'"
by (auto simp: cat_op_simps)
from assms g g' f f' have [cat_cs_simps]:
"πβ¦ArrMapβ¦β¦g' ββ©Aβπβ f', g ββ©Aβπ
β fβ¦β©β =
πβ¦ArrMapβ¦β¦[g', g]β©β ββ©Aβπ Γβ©C π
β [f', f]β©ββ¦"
by (cs_concl cs_simp: cat_prod_2_Comp_app cs_intro: cat_prod_cs_intros)
from assms g g' f f' show
"bifunctor_flip π π
πβ¦ArrMapβ¦β¦gg' ββ©Aβπ
Γβ©C πβ ff'β¦ =
bifunctor_flip π π
πβ¦ArrMapβ¦β¦gg'β¦ ββ©Aβββ
bifunctor_flip π π
πβ¦ArrMapβ¦β¦ff'β¦"
unfolding gg'_def ff'_def
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps
cs_intro: cat_prod_cs_intros cat_cs_intros
)
qed
show
"bifunctor_flip π π
πβ¦ArrMapβ¦β¦(π
Γβ©C π)β¦CIdβ¦β¦baβ¦β¦ =
ββ¦CIdβ¦β¦bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦β¦"
if "ba ββ©β (π
Γβ©C π)β¦Objβ¦" for ba
proof-
from that obtain b a
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
from assms b a have [cat_cs_simps]:
"πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦β¦β©β =
πβ¦ArrMapβ¦β¦(π Γβ©C π
)β¦CIdβ¦β¦a, bβ¦β©ββ¦"
by (cs_concl cs_simp: cat_prod_2_CId_app cs_intro: cat_prod_cs_intros)
from assms b a show ?thesis
unfolding ba_def
by
(
cs_concl
cs_intro: cat_cs_intros cat_prod_cs_intros
cs_simp: cat_prod_cs_simps cat_cs_simps
)
qed
qed (auto simp: bifunctor_flip_components cat_cs_simps cat_cs_intros)
qed
lemma bifunctor_flip_is_functor'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π = π
Γβ©C π"
shows "bifunctor_flip π π
π : π β¦β¦β©CβΞ±β β"
using assms(1-3) unfolding assms(4) by (intro bifunctor_flip_is_functor)
subsubsectionβΉDouble-flip of a bifunctorβΊ
lemma bifunctor_flip_flip[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "bifunctor_flip π
π (bifunctor_flip π π
π) = π"
proof(rule cf_eqI)
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_functor Ξ± βΉπ Γβ©C π
βΊ β π by (rule assms(3))
from assms show
"bifunctor_flip π
π (bifunctor_flip π π
π) : π Γβ©C π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms have ObjMap_dom_lhs:
"πβ©β (bifunctor_flip π
π (bifunctor_flip π π
π)β¦ObjMapβ¦) =
(π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ObjMap_dom_rhs: "πβ©β (πβ¦ObjMapβ¦) = (π Γβ©C π
)β¦Objβ¦"
by (simp add: cat_cs_simps)
from assms have ArrMap_dom_lhs:
"πβ©β (bifunctor_flip π
π (bifunctor_flip π π
π)β¦ArrMapβ¦) =
(π Γβ©C π
)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ArrMap_dom_rhs: "πβ©β (πβ¦ArrMapβ¦) = (π Γβ©C π
)β¦Arrβ¦"
by (simp add: cat_cs_simps)
show "bifunctor_flip π
π (bifunctor_flip π π
π)β¦ObjMapβ¦ = πβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β" and a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (rule cat_prod_2_ObjE[OF assms(1,2)])
from assms a b show
"bifunctor_flip π
π (bifunctor_flip π π
π)β¦ObjMapβ¦β¦abβ¦ = πβ¦ObjMapβ¦β¦abβ¦"
unfolding ab_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cat_cs_intros)
show "bifunctor_flip π
π (bifunctor_flip π π
π)β¦ArrMapβ¦ = πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Arrβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β" and a: "a ββ©β πβ¦Arrβ¦" and b: "b ββ©β π
β¦Arrβ¦"
by (rule cat_prod_2_ArrE[OF assms(1,2)])
from assms a b show
"bifunctor_flip π
π (bifunctor_flip π π
π)β¦ArrMapβ¦β¦abβ¦ = πβ¦ArrMapβ¦β¦abβ¦"
unfolding ab_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cat_cs_intros)
qed (simp_all add: assms(3))
subsubsectionβΉA projection of a bifunctor flipβΊ
lemma bifunctor_flip_proj_snd[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F = πβπ,π
β(-,b)β©Cβ©F"
proof(rule cf_eqI)
from assms show f_πb: "bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show πb: "πβπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms have ObjMap_dom_lhs:
"πβ©β ((bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ObjMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ObjMap_dom_rhs: "πβ©β ((πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms have ArrMap_dom_lhs:
"πβ©β ((bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ArrMapβ¦) = πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ArrMap_dom_rhs: "πβ©β ((πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦) = πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "(bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ObjMapβ¦ = (πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from assms show "vsv ((bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ObjMapβ¦)"
by (intro bifunctor_proj_snd_ObjMap_vsv)
(cs_concl cs_intro: cat_cs_intros)
from assms show "vsv ((πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦)"
by (intro bifunctor_proj_fst_ObjMap_vsv)
(cs_concl cs_intro: cat_cs_intros)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms show
"(bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ =
(πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
qed simp
show
"(bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ArrMapβ¦ = (πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
from assms show "vsv ((bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ArrMapβ¦)"
by (intro bifunctor_proj_snd_ArrMap_vsv)
(cs_concl cs_intro: cat_cs_intros)
from assms show "vsv ((πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦)"
by (intro bifunctor_proj_fst_ArrMap_vsv)
(cs_concl cs_intro: cat_cs_intros)
fix f assume "f ββ©β πβ¦Arrβ¦"
with assms show
"(bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ =
(πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed simp
qed simp_all
lemma bifunctor_flip_proj_fst[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
shows "bifunctor_flip π π
πβπ
,πβ(-,a)β©Cβ©F = πβπ,π
β(a,-)β©Cβ©F"
proof-
from assms have f_π: "bifunctor_flip π π
π : π
Γβ©C π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show ?thesis
by
(
rule
bifunctor_flip_proj_snd
[
OF assms(2,1) f_π assms(4),
unfolded bifunctor_flip_flip[OF assms(1,2,3)],
symmetric
]
)
qed
subsubsectionβΉA flip of a bifunctor isomorphismβΊ
lemma bifunctor_flip_is_iso_functor:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β"
shows "bifunctor_flip π π
π : π
Γβ©C π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β "
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_iso_functor Ξ± βΉπ Γβ©C π
βΊ β π by (rule assms(3))
from assms have f_π: "bifunctor_flip π π
π : π
Γβ©C π β¦β¦β©CβΞ±β β "
by (cs_concl cs_intro: cat_cs_intros)
from f_π have ObjMap_dom:
"πβ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) = (π
Γβ©C π)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from f_π have ArrMap_dom:
"πβ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) = (π
Γβ©C π)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(intro is_iso_functorI' vsv.vsv_valeq_v11I, unfold ObjMap_dom ArrMap_dom)
from assms show "bifunctor_flip π π
π : π
Γβ©C π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix ba b'a'
assume prems:
"ba ββ©β (π
Γβ©C π)β¦Objβ¦"
"b'a' ββ©β (π
Γβ©C π)β¦Objβ¦"
"bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ = bifunctor_flip π π
πβ¦ObjMapβ¦β¦b'a'β¦"
from prems(1) obtain b a
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(2,1)])
from prems(2) obtain a' b'
where b'a'_def: "b'a' = [b', a']β©β"
and b': "b' ββ©β π
β¦Objβ¦"
and a': "a' ββ©β πβ¦Objβ¦"
by (rule cat_prod_2_ObjE[OF assms(2,1)])
from prems(3) assms a b b' a' have πab_πa'b':
"πβ¦ObjMapβ¦β¦a, bβ¦β©β = πβ¦ObjMapβ¦β¦a', b'β¦β©β"
unfolding ba_def b'a'_def
by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
from assms a b a' b' have "[a, b]β©β = [a', b']β©β"
by
(
cs_concl
cs_intro:
π.ObjMap.v11_eq_iff[THEN iffD1, OF _ _ πab_πa'b']
cat_prod_cs_intros
)
then show "ba = b'a'" unfolding ba_def b'a'_def by simp
next
fix fg f'g' assume prems:
"fg ββ©β (π
Γβ©C π)β¦Arrβ¦"
"f'g' ββ©β (π
Γβ©C π)β¦Arrβ¦"
"bifunctor_flip π π
πβ¦ArrMapβ¦β¦fgβ¦ = bifunctor_flip π π
πβ¦ArrMapβ¦β¦f'g'β¦"
from prems(1) obtain f g
where fg_def: "fg = [f, g]β©β"
and f: "f ββ©β π
β¦Arrβ¦"
and g: "g ββ©β πβ¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF assms(2,1)])
from prems(2) obtain f' g'
where f'g'_def: "f'g' = [f', g']β©β"
and f': "f' ββ©β π
β¦Arrβ¦"
and g': "g' ββ©β πβ¦Arrβ¦"
by (rule cat_prod_2_ArrE[OF assms(2,1)])
from prems(3) assms f g f' g' have πgf_πg'f':
"πβ¦ArrMapβ¦β¦g, fβ¦β©β = πβ¦ArrMapβ¦β¦g', f'β¦β©β"
unfolding fg_def f'g'_def
by (cs_prems cs_simp: cat_cs_simps cs_intro: cf_cs_intros)
from assms g f g' f' have "[g, f]β©β = [g', f']β©β"
by
(
cs_concl
cs_simp:
cs_intro:
π.ArrMap.v11_eq_iff[THEN iffD1, OF _ _ πgf_πg'f']
cat_prod_cs_intros
)
then show "fg = f'g'" unfolding fg_def f'g'_def by simp
next
show "ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) = ββ¦Objβ¦"
proof(rule vsubset_antisym)
show "ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold ObjMap_dom)
fix ba assume "ba ββ©β (π
Γβ©C π)β¦Objβ¦"
then obtain b a
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(2,1)])
from assms b a show "bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ ββ©β ββ¦Objβ¦"
unfolding ba_def
by (cs_concl cs_intro: cat_cs_intros cf_cs_intros cat_prod_cs_intros)
qed (auto simp: cat_cs_intros)
show "ββ¦Objβ¦ ββ©β ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦)"
proof(intro vsubsetI)
fix c assume prems: "c ββ©β ββ¦Objβ¦"
from prems obtain ab
where ab: "ab ββ©β (π Γβ©C π
)β¦Objβ¦" and πab: "πβ¦ObjMapβ¦β¦abβ¦ = c"
by blast
from ab obtain b a
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
show "c ββ©β ββ©β (bifunctor_flip π π
πβ¦ObjMapβ¦)"
proof(intro vsv.vsv_vimageI2', unfold ObjMap_dom)
from assms a b show "[b, a]β©β ββ©β (π
Γβ©C π)β¦Objβ¦"
by (cs_concl cs_intro: cat_prod_cs_intros)
from assms b a prems show "c = bifunctor_flip π π
πβ¦ObjMapβ¦β¦b, aβ¦β©β"
by
(
cs_concl
cs_simp: πab[unfolded ab_def] cat_cs_simps
cs_intro: cf_cs_intros
)
qed (auto intro: cat_cs_intros)
qed
qed
show "ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) = ββ¦Arrβ¦"
proof(rule vsubset_antisym)
show "ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold ArrMap_dom)
show "vsv (bifunctor_flip π π
πβ¦ArrMapβ¦)" by (auto intro: cat_cs_intros)
fix fg assume "fg ββ©β (π
Γβ©C π)β¦Arrβ¦"
then obtain f g
where fg_def: "fg = [f, g]β©β"
and f: "f ββ©β π
β¦Arrβ¦"
and g: "g ββ©β πβ¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF assms(2,1)])
from g f obtain a b a' b'
where f: "f : a β¦βπ
β b" and g: "g : a' β¦βπβ b'"
by (auto intro!: is_arrI)
from assms f g show "bifunctor_flip π π
πβ¦ArrMapβ¦β¦fgβ¦ ββ©β ββ¦Arrβ¦"
by (cs_concl cs_simp: fg_def cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
show "ββ¦Arrβ¦ ββ©β ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦)"
proof(intro vsubsetI)
fix c assume prems: "c ββ©β ββ¦Arrβ¦"
from prems obtain ab
where ab: "ab ββ©β (π Γβ©C π
)β¦Arrβ¦" and πab: "πβ¦ArrMapβ¦β¦abβ¦ = c"
by blast
from ab obtain b a
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Arrβ¦"
and b: "b ββ©β π
β¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF assms(1,2)])
show "c ββ©β ββ©β (bifunctor_flip π π
πβ¦ArrMapβ¦)"
proof(intro vsv.vsv_vimageI2', unfold ArrMap_dom)
from assms a b show "[b, a]β©β ββ©β (π
Γβ©C π)β¦Arrβ¦"
by (cs_concl cs_intro: cat_prod_cs_intros)
from assms b a prems show "c = bifunctor_flip π π
πβ¦ArrMapβ¦β¦b, aβ¦β©β"
by
(
cs_concl
cs_simp: πab[unfolded ab_def] cat_cs_simps
cs_intro: cat_cs_intros
)
qed (auto intro: cat_cs_intros)
qed
qed
qed (auto intro: cat_cs_intros)
qed
subsectionβΉArray bifunctorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter II-3 in \cite{mac_lane_categories_2010}.βΊ
definition cf_array :: "V β V β V β (V β V) β (V β V) β V"
where "cf_array π
β π π π =
[
(Ξ»aββ©β(π
Γβ©C β)β¦Objβ¦. π (vpfst a)β¦ObjMapβ¦β¦vpsnd aβ¦),
(
Ξ»fββ©β(π
Γβ©C β)β¦Arrβ¦.
π (π
β¦Codβ¦β¦vpfst fβ¦)β¦ArrMapβ¦β¦vpsnd fβ¦ ββ©Aβπβ
π (ββ¦Domβ¦β¦vpsnd fβ¦)β¦ArrMapβ¦β¦vpfst fβ¦
),
π
Γβ©C β,
π
]β©β"
textβΉComponents.βΊ
lemma cf_array_components:
shows "cf_array π
β π π πβ¦ObjMapβ¦ =
(Ξ»aββ©β(π
Γβ©C β)β¦Objβ¦. π (vpfst a)β¦ObjMapβ¦β¦vpsnd aβ¦)"
and "cf_array π
β π π πβ¦ArrMapβ¦ =
(
Ξ»fββ©β(π
Γβ©C β)β¦Arrβ¦.
π (π
β¦Codβ¦β¦vpfst fβ¦)β¦ArrMapβ¦β¦vpsnd fβ¦ ββ©Aβπβ
π (ββ¦Domβ¦β¦vpsnd fβ¦)β¦ArrMapβ¦β¦vpfst fβ¦
)"
and "cf_array π
β π π πβ¦HomDomβ¦ = π
Γβ©C β"
and "cf_array π
β π π πβ¦HomCodβ¦ = π"
unfolding cf_array_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
lemma cf_array_ObjMap_vsv: "vsv (cf_array π
β π π πβ¦ObjMapβ¦)"
unfolding cf_array_components by simp
lemma cf_array_ObjMap_vdomain[cat_cs_simps]:
"πβ©β (cf_array π
β π π πβ¦ObjMapβ¦) = (π
Γβ©C β)β¦Objβ¦"
unfolding cf_array_components by simp
lemma cf_array_ObjMap_app[cat_cs_simps]:
assumes "[b, c]β©β ββ©β (π
Γβ©C β)β¦Objβ¦"
shows "cf_array π
β π π πβ¦ObjMapβ¦β¦b, cβ¦β©β = π bβ¦ObjMapβ¦β¦cβ¦"
using assms unfolding cf_array_components by (simp add: nat_omega_simps)
lemma cf_array_ObjMap_vrange:
assumes "category Ξ± π
"
and "category Ξ± β"
and "βb. b ββ©β π
β¦Objβ¦ βΉ π b : β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_array π
β π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ObjMap_vdomain)
show "vsv (cf_array π
β π π πβ¦ObjMapβ¦)" by (rule cf_array_ObjMap_vsv)
fix x assume prems: "x ββ©β (π
Γβ©C β)β¦Objβ¦"
then obtain b c where x_def: "x = [b, c]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and c: "c ββ©β ββ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
interpret πb: is_functor Ξ± β π βΉπ bβΊ by (rule assms(3)[OF b])
from prems c show "cf_array π
β π π πβ¦ObjMapβ¦β¦xβ¦ ββ©β πβ¦Objβ¦"
unfolding x_def cf_array_components
by (auto simp: nat_omega_simps cat_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
lemma cf_array_ArrMap_vsv: "vsv (cf_array π
β π π πβ¦ArrMapβ¦)"
unfolding cf_array_components by simp
lemma cf_array_ArrMap_vdomain[cat_cs_simps]:
"πβ©β (cf_array π
β π π πβ¦ArrMapβ¦) = (π
Γβ©C β)β¦Arrβ¦"
unfolding cf_array_components by simp
lemma cf_array_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± π
"
and "category Ξ± β"
and "g : a β¦βπ
β b"
and "f : a' β¦βββ b'"
shows "cf_array π
β π π πβ¦ArrMapβ¦β¦g, fβ¦β©β =
π bβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ π a'β¦ArrMapβ¦β¦gβ¦"
proof-
interpret π
: category Ξ± π
by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
from cat_prod_2_is_arrI[OF assms] have "[g, f]β©β ββ©β (π
Γβ©C β)β¦Arrβ¦" by auto
with assms show ?thesis
unfolding cf_array_components by (simp add: nat_omega_simps cat_cs_simps)
qed
lemma cf_array_ArrMap_vrange:
assumes "category Ξ± π
"
and "category Ξ± β"
and "βc. c ββ©β ββ¦Objβ¦ βΉ π c : π
β¦β¦β©CβΞ±β π"
and "βb. b ββ©β π
β¦Objβ¦ βΉ π b : β β¦β¦β©CβΞ±β π"
and [cat_cs_simps]:
"βb c. b ββ©β π
β¦Objβ¦ βΉ c ββ©β ββ¦Objβ¦ βΉ π bβ¦ObjMapβ¦β¦cβ¦ = π cβ¦ObjMapβ¦β¦bβ¦"
shows "ββ©β (cf_array π
β π π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_array_ArrMap_vdomain)
interpret π
: category Ξ± π
by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
interpret π
β: category Ξ± βΉπ
Γβ©C ββΊ
by (simp add: π
.category_axioms β.category_axioms category_cat_prod_2)
fix gf assume prems: "gf ββ©β (π
Γβ©C β)β¦Arrβ¦"
then obtain bc b'c' where gf: "gf : bc β¦βπ
Γβ©C ββ b'c'" by auto
then obtain g f b c b' c'
where gf_def: "gf = [g, f]β©β"
and "bc = [b, c]β©β"
and "b'c' = [b', c']β©β"
and g: "g : b β¦βπ
β b'"
and f: "f : c β¦βββ c'"
by (elim cat_prod_2_is_arrE[OF assms(1,2)])
then have b: "b ββ©β π
β¦Objβ¦"
and b': "b' ββ©β π
β¦Objβ¦"
and c: "c ββ©β ββ¦Objβ¦"
and c': "c' ββ©β ββ¦Objβ¦"
by auto
interpret πb: is_functor Ξ± β π βΉπ bβΊ by (rule assms(4)[OF b])
interpret πc: is_functor Ξ± π
π βΉπ cβΊ by (rule assms(3)[OF c])
interpret πb': is_functor Ξ± β π βΉπ b'βΊ by (rule assms(4)[OF b'])
interpret πc': is_functor Ξ± π
π βΉπ c'βΊ by (rule assms(3)[OF c'])
from
πb.is_functor_axioms
πc.is_functor_axioms
πb'.is_functor_axioms
πc'.is_functor_axioms
πb.HomCod.category_axioms
g f
have "π b'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ π cβ¦ArrMapβ¦β¦gβ¦ ββ©β πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
with g f prems show "cf_array π
β π π πβ¦ArrMapβ¦β¦gfβ¦ ββ©β πβ¦Arrβ¦"
unfolding gf_def cf_array_components
by (simp add: nat_omega_simps cat_cs_simps)
qed (simp add: cf_array_ArrMap_vsv)
subsubsectionβΉArray bifunctor is a bifunctorβΊ
lemma cf_array_specification:
assumes "category Ξ± π
"
and "category Ξ± β"
and "category Ξ± π"
and "βc. c ββ©β ββ¦Objβ¦ βΉ π c : π
β¦β¦β©CβΞ±β π"
and "βb. b ββ©β π
β¦Objβ¦ βΉ π b : β β¦β¦β©CβΞ±β π"
and "βb c. b ββ©β π
β¦Objβ¦ βΉ c ββ©β ββ¦Objβ¦ βΉ π bβ¦ObjMapβ¦β¦cβ¦ = π cβ¦ObjMapβ¦β¦bβ¦"
and
"βb c b' c' f g. β¦ f : b β¦βπ
β b'; g : c β¦βββ c' β§ βΉ
π b'β¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ π cβ¦ArrMapβ¦β¦fβ¦ =
π c'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ π bβ¦ArrMapβ¦β¦gβ¦"
shows cf_array_is_functor: "cf_array π
β π π π : π
Γβ©C β β¦β¦β©CβΞ±β π"
and cf_array_ObjMap_app_fst: "βb c. β¦ b ββ©β π
β¦Objβ¦; c ββ©β ββ¦Objβ¦ β§ βΉ
cf_array π
β π π πβ¦ObjMapβ¦β¦b, cβ¦β©β = π cβ¦ObjMapβ¦β¦bβ¦"
and cf_array_ObjMap_app_snd: "βb c. β¦ b ββ©β π
β¦Objβ¦; c ββ©β ββ¦Objβ¦ β§ βΉ
cf_array π
β π π πβ¦ObjMapβ¦β¦b, cβ¦β©β = π bβ¦ObjMapβ¦β¦cβ¦"
and cf_array_ArrMap_app_fst: "βa b f c. β¦ f : a β¦βπ
β b; c ββ©β ββ¦Objβ¦β§ βΉ
cf_array π
β π π πβ¦ArrMapβ¦β¦f, ββ¦CIdβ¦β¦cβ¦β¦β©β = π cβ¦ArrMapβ¦β¦fβ¦"
and cf_array_ArrMap_app_snd: "βa b g c. β¦ g : a β¦βββ b; c ββ©β π
β¦Objβ¦ β§ βΉ
cf_array π
β π π πβ¦ArrMapβ¦β¦π
β¦CIdβ¦β¦cβ¦, gβ¦β©β = π cβ¦ArrMapβ¦β¦gβ¦"
proof-
interpret π
: category Ξ± π
by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
interpret π: category Ξ± π by (rule assms(3))
from assms(4) have [cat_cs_intros]: "π c : π
' β¦β¦β©CβΞ±'β π'"
if "c ββ©β ββ¦Objβ¦" "π
' = π
" "π' = π" "Ξ±' = Ξ±" for Ξ±' c π
' π'
using that(1) unfolding that(2-4) by (intro assms(4))
from assms(4) have [cat_cs_intros]: "π c : β' β¦β¦β©CβΞ±'β π'"
if "c ββ©β π
β¦Objβ¦" "β' = β" "π' = π" "Ξ±' = Ξ±" for Ξ±' c β' π'
using that(1) unfolding that(2-4) by (intro assms(5))
show "cf_array π
β π π π : π
Γβ©C β β¦β¦β©CβΞ±β π"
proof(intro is_functorI')
show "vfsequence (cf_array π
β π π π)" unfolding cf_array_def by auto
from assms(1,2) show "category Ξ± (π
Γβ©C β)"
by (simp add: category_cat_prod_2)
show "vcard (cf_array π
β π π π) = 4β©β"
unfolding cf_array_def by (simp add: nat_omega_simps)
show "ββ©β (cf_array π
β π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
by (rule cf_array_ObjMap_vrange) (auto simp: assms intro: cat_cs_intros)
show cf_array_is_arrI: "cf_array π
β π π πβ¦ArrMapβ¦β¦ff'β¦ :
cf_array π
β π π πβ¦ObjMapβ¦β¦aa'β¦ β¦βπβ cf_array π
β π π πβ¦ObjMapβ¦β¦bb'β¦"
if ff': "ff' : aa' β¦βπ
Γβ©C ββ bb'" for aa' bb' ff'
proof-
obtain f f' a a' b b'
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and bb'_def: "bb' = [b, b']β©β"
and f: "f : a β¦βπ
β b"
and f': "f' : a' β¦βββ b'"
by (elim cat_prod_2_is_arrE[OF π
.category_axioms β.category_axioms ff'])
then have a: "a ββ©β π
β¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
and a': "a' ββ©β ββ¦Objβ¦"
and b': "b' ββ©β ββ¦Objβ¦"
by auto
from f' assms(5)[OF a] a have
"π aβ¦ArrMapβ¦β¦f'β¦ : π a'β¦ObjMapβ¦β¦aβ¦ β¦βπβ π b'β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
with assms(1-3) f f' assms(4)[OF b'] show ?thesis
unfolding ff'_def aa'_def bb'_def
by
(
cs_concl
cs_simp: cat_cs_simps assms(6)
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show "cf_array π
β π π πβ¦ArrMapβ¦β¦gg' ββ©Aβπ
Γβ©C ββ ff'β¦ =
cf_array π
β π π πβ¦ArrMapβ¦β¦gg'β¦ ββ©Aβπβ cf_array π
β π π πβ¦ArrMapβ¦β¦ff'β¦"
if gg': "gg' : bb' β¦βπ
Γβ©C ββ cc'" and ff': "ff' : aa' β¦βπ
Γβ©C ββ bb'"
for bb' cc' gg' aa' ff'
proof-
obtain g g' b b' c c'
where gg'_def: "gg' = [g, g']β©β"
and bb'_def: "bb' = [b, b']β©β"
and cc'_def: "cc' = [c, c']β©β"
and g: "g : b β¦βπ
β c"
and g': "g' : b' β¦βββ c'"
by (elim cat_prod_2_is_arrE[OF π
.category_axioms β.category_axioms gg'])
moreover obtain f f' a a' b'' b'''
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and "bb' = [b'', b''']β©β"
and f: "f : a β¦βπ
β b''"
and f': "f' : a' β¦βββ b'''"
by (elim cat_prod_2_is_arrE[OF π
.category_axioms β.category_axioms ff'])
ultimately have f: "f : a β¦βπ
β b" and f': "f' : a' β¦βββ b'" by auto
with g have a: "a ββ©β π
β¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
and c: "c ββ©β π
β¦Objβ¦"
and a': "a' ββ©β ββ¦Objβ¦"
and b': "b' ββ©β ββ¦Objβ¦"
and c': "b' ββ©β ββ¦Objβ¦"
by auto
from f' assms(5)[OF a] a have πa_f':
"π aβ¦ArrMapβ¦β¦f'β¦ : π a'β¦ObjMapβ¦β¦aβ¦ β¦βπβ π b'β¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
from f' b assms(5)[OF b] have πb_f':
"π bβ¦ArrMapβ¦β¦f'β¦ : π a'β¦ObjMapβ¦β¦bβ¦ β¦βπβ π b'β¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
from f' c assms(5)[OF c] have πc_f':
"π cβ¦ArrMapβ¦β¦f'β¦ : π a'β¦ObjMapβ¦β¦cβ¦ β¦βπβ π b'β¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_simp: assms(6)[symmetric] cs_intro: cat_cs_intros)
have
"π b'β¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ (π b'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ π aβ¦ArrMapβ¦β¦f'β¦) =
(π cβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπβ π a'β¦ArrMapβ¦β¦gβ¦) ββ©Aβπβ π a'β¦ArrMapβ¦β¦fβ¦"
using f' f g πb_f' assms(4)[OF a'] assms(4)[OF b']
by (cs_concl cs_simp: cat_cs_simps assms(7) cs_intro: cat_cs_intros)
also have "β¦ =
π cβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπβ (π a'β¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ π a'β¦ArrMapβ¦β¦fβ¦)"
using assms(2) f f' g g' assms(4)[OF a'] assms(5)[OF c]
by (cs_concl cs_simp: assms(6) cat_cs_simps cs_intro: cat_cs_intros)
finally have [cat_cs_simps]:
"π b'β¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ (π b'β¦ArrMapβ¦β¦fβ¦ ββ©Aβπβ π aβ¦ArrMapβ¦β¦f'β¦) =
π cβ¦ArrMapβ¦β¦f'β¦ ββ©Aβπβ (π a'β¦ArrMapβ¦β¦gβ¦ ββ©Aβπβ π a'β¦ArrMapβ¦β¦fβ¦)"
by simp
show ?thesis
using
πa_f' πc_f'
f f'
g g'
assms(1,2)
assms(4)[OF a']
assms(4)[OF c']
assms(5)[OF c]
unfolding gg'_def ff'_def aa'_def bb'_def cc'_def
by
(
cs_concl
cs_simp: assms(6,7) cat_prod_cs_simps cat_cs_simps
cs_intro: cat_prod_cs_intros cat_cs_intros
)
qed
show "cf_array π
β π π πβ¦ArrMapβ¦β¦(π
Γβ©C β)β¦CIdβ¦β¦cc'β¦β¦ =
πβ¦CIdβ¦β¦cf_array π
β π π πβ¦ObjMapβ¦β¦cc'β¦β¦"
if "cc' ββ©β (π
Γβ©C β)β¦Objβ¦" for cc'
proof-
from that obtain c c'
where cc'_def: "cc' = [c, c']β©β"
and c: "c ββ©β π
β¦Objβ¦"
and c': "c' ββ©β ββ¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
from assms(1,2,3) c c' assms(4)[OF c'] assms(5)[OF c] show ?thesis
unfolding cc'_def
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps assms(6)
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_array_components cat_cs_intros)
show "cf_array π
β π π πβ¦ObjMapβ¦ β¦b, cβ¦β©β = π cβ¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" and "c ββ©β ββ¦Objβ¦" for b c
using that assms(1,2,3)
by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_prod_cs_intros)
show "cf_array π
β π π πβ¦ObjMapβ¦ β¦b, cβ¦β©β = π bβ¦ObjMapβ¦β¦cβ¦"
if "b ββ©β π
β¦Objβ¦" and "c ββ©β ββ¦Objβ¦" for b c
using that assms(1,2,3)
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
show "cf_array π
β π π πβ¦ArrMapβ¦ β¦f, ββ¦CIdβ¦β¦cβ¦β¦β©β = π cβ¦ArrMapβ¦β¦fβ¦"
if f: "f : a β¦βπ
β b" and c: "c ββ©β ββ¦Objβ¦" for a b f c
proof-
from f have "a ββ©β π
β¦Objβ¦" and "b ββ©β π
β¦Objβ¦" by auto
from assms(5)[OF this(1)] assms(5)[OF this(2)] assms(4)[OF c] show ?thesis
using assms(1,2,3) f c
by (cs_concl cs_simp: cat_cs_simps assms(6) cs_intro: cat_cs_intros)
qed
show "cf_array π
β π π πβ¦ArrMapβ¦ β¦π
β¦CIdβ¦β¦cβ¦, gβ¦β©β = π cβ¦ArrMapβ¦β¦gβ¦"
if g: "g : a β¦βββ b" and c: "c ββ©β π
β¦Objβ¦" for a b g c
proof-
from g have "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦" by auto
from assms(4)[OF this(1)] assms(4)[OF this(2)] assms(5)[OF c] show ?thesis
using assms(1,2,3) g c
by
(
cs_concl
cs_simp: cat_cs_simps assms(6)[symmetric] cs_intro: cat_cs_intros
)
qed
qed
subsectionβΉComposition of a covariant bifunctor and covariant functorsβΊ
subsubsectionβΉDefinition and elementary properties.βΊ
definition cf_bcomp :: "V β V β V β V"
where "cf_bcomp π π π =
[
(
Ξ»aββ©β(πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦)β¦Objβ¦.
πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦vpfst aβ¦, πβ¦ObjMapβ¦β¦vpsnd aβ¦β¦β©β
),
(
Ξ»fββ©β(πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦)β¦Arrβ¦.
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦vpfst fβ¦, πβ¦ArrMapβ¦β¦vpsnd fβ¦β¦β©β
),
πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦,
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_bcomp_components:
shows "cf_bcomp π π πβ¦ObjMapβ¦ =
(
Ξ»aββ©β(πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦)β¦Objβ¦.
πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦vpfst aβ¦, πβ¦ObjMapβ¦β¦vpsnd aβ¦β¦β©β
)"
and "cf_bcomp π π πβ¦ArrMapβ¦ =
(
Ξ»fββ©β(πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦)β¦Arrβ¦.
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦vpfst fβ¦, πβ¦ArrMapβ¦β¦vpsnd fβ¦β¦β©β
)"
and "cf_bcomp π π πβ¦HomDomβ¦ = πβ¦HomDomβ¦ Γβ©C πβ¦HomDomβ¦"
and "cf_bcomp π π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_bcomp_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
lemma cf_bcomp_ObjMap_vsv: "vsv (cf_bcomp π π πβ¦ObjMapβ¦)"
unfolding cf_bcomp_components by simp
lemma cf_bcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
" and "π : β' β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_bcomp π π πβ¦ObjMapβ¦) = (π
' Γβ©C β')β¦Objβ¦"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms)
interpret π: is_functor Ξ± β' β π by (rule assms)
show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
qed
lemma cf_bcomp_ObjMap_app[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "[a, b]β©β ββ©β (π
' Γβ©C β')β¦Objβ¦"
shows "cf_bcomp π π πβ¦ObjMapβ¦β¦a, bβ¦β©β = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, πβ¦ObjMapβ¦β¦bβ¦β¦β©β"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
from assms show ?thesis
unfolding cf_bcomp_components
by (simp_all add: cat_cs_simps nat_omega_simps)
qed
lemma cf_bcomp_ObjMap_vrange:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_bcomp π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cf_bcomp_ObjMap_vdomain[OF assms(1,2)]
)
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
show "vsv (cf_bcomp π π πβ¦ObjMapβ¦)" by (rule cf_bcomp_ObjMap_vsv)
fix bc assume "bc ββ©β (π
' Γβ©C β')β¦Objβ¦"
with π.HomDom.category_axioms π.HomDom.category_axioms obtain b c
where bc_def: "bc = [b, c]β©β" and b: "b ββ©β π
'β¦Objβ¦" and c: "c ββ©β β'β¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated -1])
from assms b c show "cf_bcomp π π πβ¦ObjMapβ¦β¦bcβ¦ ββ©β πβ¦Objβ¦"
unfolding bc_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
subsubsectionβΉArrow mapβΊ
lemma cf_bcomp_ArrMap_vsv: "vsv (cf_bcomp β π πβ¦ArrMapβ¦)"
unfolding cf_bcomp_components by simp
lemma cf_bcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
" and "π : β' β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_bcomp π π πβ¦ArrMapβ¦) = (π
' Γβ©C β')β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
show ?thesis unfolding cf_bcomp_components by (simp add: cat_cs_simps)
qed
lemma cf_bcomp_ArrMap_app[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "[g, f]β©β ββ©β (π
' Γβ©C β')β¦Arrβ¦"
shows "cf_bcomp π π πβ¦ArrMapβ¦β¦g, fβ¦β©β = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦gβ¦, πβ¦ArrMapβ¦β¦fβ¦β¦β©β"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
from assms show ?thesis
unfolding cf_bcomp_components by (simp_all add: nat_omega_simps cat_cs_simps)
qed
lemma cf_bcomp_ArrMap_vrange:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_bcomp π π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_bcomp_ArrMap_vdomain[OF assms(1,2)])
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
fix gf assume "gf ββ©β (π
' Γβ©C β')β¦Arrβ¦"
with π.HomDom.category_axioms π.HomDom.category_axioms obtain g f
where gf_def: "gf = [g, f]β©β" and g: "g ββ©β π
'β¦Arrβ¦" and f: "f ββ©β β'β¦Arrβ¦"
by (elim cat_prod_2_ArrE[rotated -1])
from g obtain a b where g: "g : a β¦βπ
'β b" by auto
from f obtain a' b' where f: "f : a' β¦ββ'β b'" by auto
from assms g f show "cf_bcomp π π πβ¦ArrMapβ¦β¦gfβ¦ ββ©β πβ¦Arrβ¦"
unfolding gf_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (simp add: cf_bcomp_ArrMap_vsv)
subsubsectionβΉ
Composition of a covariant bifunctor and
covariant functors is a functor
βΊ
lemma cf_bcomp_is_functor:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_bcomp π π π : π
' Γβ©C β' β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
interpret π: is_functor Ξ± βΉπ
Γβ©C ββΊ π π by (rule assms(3))
show ?thesis
proof(intro is_functorI')
show "vfsequence (cf_bcomp π π π)" unfolding cf_bcomp_def by simp
show "category Ξ± (π
' Γβ©C β')"
by
(
simp add:
π.HomDom.category_axioms
π.HomDom.category_axioms
category_cat_prod_2
)
show "vcard (cf_bcomp π π π) = 4β©β"
unfolding cf_bcomp_def by (simp add: nat_omega_simps)
from assms show "ββ©β (cf_bcomp π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
by (rule cf_bcomp_ObjMap_vrange)
show "cf_bcomp π π πβ¦ArrMapβ¦β¦ff'β¦ :
cf_bcomp π π πβ¦ObjMapβ¦β¦aa'β¦ β¦βπβ cf_bcomp π π πβ¦ObjMapβ¦β¦bb'β¦"
if ff': "ff' : aa' β¦βπ
' Γβ©C β'β bb'" for aa' bb' ff'
proof-
obtain f f' a a' b b'
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and bb'_def: "bb' = [b, b']β©β"
and f: "f : a β¦βπ
'β b"
and f': "f' : a' β¦ββ'β b'"
by
(
elim
cat_prod_2_is_arrE[
OF π.HomDom.category_axioms π.HomDom.category_axioms ff'
]
)
from assms f f' show ?thesis
unfolding ff'_def aa'_def bb'_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show "cf_bcomp π π πβ¦ArrMapβ¦β¦gg' ββ©Aβπ
' Γβ©C β'β ff'β¦ =
cf_bcomp π π πβ¦ArrMapβ¦β¦gg'β¦ ββ©Aβπβ cf_bcomp π π πβ¦ArrMapβ¦β¦ff'β¦"
if gg': "gg' : bb' β¦βπ
' Γβ©C β'β cc'"
and ff': "ff' : aa' β¦βπ
' Γβ©C β'β bb'"
for bb' cc' gg' aa' ff'
proof-
obtain g g' b b' c c'
where gg'_def: "gg' = [g, g']β©β"
and bb'_def: "bb' = [b, b']β©β"
and cc'_def: "cc' = [c, c']β©β"
and g: "g : b β¦βπ
'β c"
and g': "g' : b' β¦ββ'β c'"
by
(
elim cat_prod_2_is_arrE[
OF π.HomDom.category_axioms π.HomDom.category_axioms gg'
]
)
moreover obtain f f' a a' b'' b'''
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and "bb' = [b'', b''']β©β"
and f: "f : a β¦βπ
'β b''"
and f': "f' : a' β¦ββ'β b'''"
by
(
elim cat_prod_2_is_arrE[
OF π.HomDom.category_axioms π.HomDom.category_axioms ff'
]
)
ultimately have f: "f : a β¦βπ
'β b" and f': "f' : a' β¦ββ'β b'" by auto
from assms f f' g g' have [cat_cs_simps]:
"[πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦, πβ¦ArrMapβ¦β¦g'β¦ ββ©Aβββ πβ¦ArrMapβ¦β¦f'β¦]β©β =
[πβ¦ArrMapβ¦β¦gβ¦, πβ¦ArrMapβ¦β¦g'β¦]β©β ββ©Aβπ
Γβ©C ββ [πβ¦ArrMapβ¦β¦fβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β"
by
(
cs_concl
cs_simp: cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from assms f f' g g' show ?thesis
unfolding gg'_def ff'_def aa'_def bb'_def cc'_def
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"cf_bcomp π π πβ¦ArrMapβ¦β¦(π
' Γβ©C β')β¦CIdβ¦β¦cc'β¦β¦ =
πβ¦CIdβ¦β¦cf_bcomp π π πβ¦ObjMapβ¦β¦cc'β¦β¦"
if "cc' ββ©β (π
' Γβ©C β')β¦Objβ¦" for cc'
proof-
from that obtain c c'
where cc'_def: "cc' = [c, c']β©β"
and c: "c ββ©β π
'β¦Objβ¦"
and c': "c' ββ©β β'β¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
from assms c c' have [cat_cs_simps]:
"[π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦, ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦c'β¦β¦]β©β =
(π
Γβ©C β)β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦, πβ¦ObjMapβ¦β¦c'β¦β¦β©β"
by
(
cs_concl
cs_simp: cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from assms c c' show ?thesis
unfolding cc'_def
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_bcomp_components cat_cs_intros cat_cs_simps)
qed
lemma cf_bcomp_is_functor'[cat_cs_intros]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
and "π' = π
' Γβ©C β'"
shows "cf_bcomp π π π : π' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_bcomp_is_functor)
subsectionβΉComposition of a contracovariant bifunctor and covariant functorsβΊ
textβΉ
The term βΉcontracovariant bifunctorβΊ is used to refer to a bifunctor
that is contravariant in the first argument and covariant in the second
argument.
βΊ
definition cf_cn_cov_bcomp :: "V β V β V β V"
where "cf_cn_cov_bcomp π π π =
[
(
Ξ»aββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦)β¦Objβ¦.
πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦vpfst aβ¦, πβ¦ObjMapβ¦β¦vpsnd aβ¦β¦β©β
),
(
Ξ»fββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦)β¦Arrβ¦.
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦vpfst fβ¦, πβ¦ArrMapβ¦β¦vpsnd fβ¦β¦β©β
),
op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦,
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_cn_cov_bcomp_components:
shows "cf_cn_cov_bcomp π π πβ¦ObjMapβ¦ =
(
Ξ»aββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦)β¦Objβ¦.
πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦vpfst aβ¦, πβ¦ObjMapβ¦β¦vpsnd aβ¦β¦β©β
)"
and "cf_cn_cov_bcomp π π πβ¦ArrMapβ¦ =
(
Ξ»fββ©β(op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦)β¦Arrβ¦.
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦vpfst fβ¦, πβ¦ArrMapβ¦β¦vpsnd fβ¦β¦β©β
)"
and "cf_cn_cov_bcomp π π πβ¦HomDomβ¦ = op_cat (πβ¦HomDomβ¦) Γβ©C πβ¦HomDomβ¦"
and "cf_cn_cov_bcomp π π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_cn_cov_bcomp_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
lemma cf_cn_cov_bcomp_ObjMap_vsv: "vsv (cf_cn_cov_bcomp π π πβ¦ObjMapβ¦)"
unfolding cf_cn_cov_bcomp_components by simp
lemma cf_cn_cov_bcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
" and "π : β' β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_cn_cov_bcomp π π πβ¦ObjMapβ¦) = (op_cat π
' Γβ©C β')β¦Objβ¦"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
show ?thesis
unfolding cf_cn_cov_bcomp_components
by (simp add: nat_omega_simps cat_cs_simps)
qed
lemma cf_cn_cov_bcomp_ObjMap_app[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "[a, b]β©β ββ©β (op_cat π
' Γβ©C β')β¦Objβ¦"
shows
"cf_cn_cov_bcomp π π πβ¦ObjMapβ¦β¦a, bβ¦β©β =
πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, πβ¦ObjMapβ¦β¦bβ¦β¦β©β"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
from assms show ?thesis
unfolding cf_cn_cov_bcomp_components
by (simp_all add: cat_cs_simps nat_omega_simps)
qed
lemma cf_cn_cov_bcomp_ObjMap_vrange:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_bcomp π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cf_cn_cov_bcomp_ObjMap_vdomain[OF assms(1,2)]
)
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
show "vsv (cf_cn_cov_bcomp π π πβ¦ObjMapβ¦)"
by (rule cf_cn_cov_bcomp_ObjMap_vsv)
fix bc assume "bc ββ©β (op_cat π
' Γβ©C β')β¦Objβ¦"
with π.HomDom.category_op π.HomDom.category_axioms obtain b c
where bc_def: "bc = [b, c]β©β"
and b: "b ββ©β op_cat π
'β¦Objβ¦"
and c: "c ββ©β β'β¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated -1])
from assms b c show "cf_cn_cov_bcomp π π πβ¦ObjMapβ¦β¦bcβ¦ ββ©β πβ¦Objβ¦"
unfolding bc_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
subsubsectionβΉArrow mapβΊ
lemma cf_cn_cov_bcomp_ArrMap_vsv: "vsv (cf_cn_cov_bcomp β π πβ¦ArrMapβ¦)"
unfolding cf_cn_cov_bcomp_components by simp
lemma cf_cn_cov_bcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
" and "π : β' β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_cn_cov_bcomp π π πβ¦ArrMapβ¦) = (op_cat π
' Γβ©C β')β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
show ?thesis unfolding cf_cn_cov_bcomp_components by (simp add: cat_cs_simps)
qed
lemma cf_cn_cov_bcomp_ArrMap_app[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "[g, f]β©β ββ©β (op_cat π
' Γβ©C β')β¦Arrβ¦"
shows "cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦g, fβ¦β©β =
πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦gβ¦, πβ¦ArrMapβ¦β¦fβ¦β¦β©β"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
from assms show ?thesis
unfolding cf_cn_cov_bcomp_components
by (simp_all add: nat_omega_simps cat_cs_simps)
qed
lemma cf_cn_cov_bcomp_ArrMap_vrange:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_bcomp π π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_cn_cov_bcomp_ArrMap_vdomain[OF assms(1,2)])
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
fix gf assume "gf ββ©β (op_cat π
' Γβ©C β')β¦Arrβ¦"
with π.HomDom.category_op π.HomDom.category_axioms obtain g f
where gf_def: "gf = [g, f]β©β"
and g: "g ββ©β op_cat π
'β¦Arrβ¦"
and f: "f ββ©β β'β¦Arrβ¦"
by (elim cat_prod_2_ArrE[rotated -1])
from g obtain a b where g: "g : a β¦βπ
'β b" unfolding cat_op_simps by auto
from f obtain a' b' where f: "f : a' β¦ββ'β b'" by auto
from assms g f show "cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦gfβ¦ ββ©β πβ¦Arrβ¦"
unfolding gf_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (rule cf_cn_cov_bcomp_ArrMap_vsv)
subsubsectionβΉ
Composition of a contracovariant bifunctor and functors is a functor
βΊ
lemma cf_cn_cov_bcomp_is_functor:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_cn_cov_bcomp π π π : op_cat π
' Γβ©C β' β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± π
' π
π by (rule assms(1))
interpret π: is_functor Ξ± β' β π by (rule assms(2))
interpret π: is_functor Ξ± βΉop_cat π
Γβ©C ββΊ π π by (rule assms(3))
show ?thesis
proof(intro is_functorI')
show "vfsequence (cf_cn_cov_bcomp π π π)"
unfolding cf_cn_cov_bcomp_def by simp
show "category Ξ± (op_cat π
' Γβ©C β')"
by
(
simp add:
π.HomDom.category_op π.HomDom.category_axioms category_cat_prod_2
)
show "vcard (cf_cn_cov_bcomp π π π) = 4β©β"
unfolding cf_cn_cov_bcomp_def by (simp add: nat_omega_simps)
from assms show "ββ©β (cf_cn_cov_bcomp π π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
by (rule cf_cn_cov_bcomp_ObjMap_vrange)
show
"cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦ff'β¦ :
cf_cn_cov_bcomp π π πβ¦ObjMapβ¦β¦aa'β¦ β¦βπβ
cf_cn_cov_bcomp π π πβ¦ObjMapβ¦β¦bb'β¦"
if ff': "ff' : aa' β¦βop_cat π
' Γβ©C β'β bb'" for aa' bb' ff'
proof-
obtain f f' a a' b b'
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and bb'_def: "bb' = [b, b']β©β"
and f: "f : a β¦βop_cat π
'β b"
and f': "f' : a' β¦ββ'β b'"
by
(
elim
cat_prod_2_is_arrE[
OF π.HomDom.category_op π.HomDom.category_axioms ff'
]
)
from assms f f' show ?thesis
unfolding ff'_def aa'_def bb'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦gg' ββ©Aβop_cat π
' Γβ©C β'β ff'β¦ =
cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦gg'β¦ ββ©Aβπβ
cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦ff'β¦"
if gg': "gg' : bb' β¦βop_cat π
' Γβ©C β'β cc'"
and ff': "ff' : aa' β¦βop_cat π
' Γβ©C β'β bb'"
for bb' cc' gg' aa' ff'
proof-
obtain g g' b b' c c'
where gg'_def: "gg' = [g, g']β©β"
and bb'_def: "bb' = [b, b']β©β"
and cc'_def: "cc' = [c, c']β©β"
and g: "g : b β¦βop_cat π
'β c"
and g': "g' : b' β¦ββ'β c'"
by
(
elim cat_prod_2_is_arrE[
OF π.HomDom.category_op π.HomDom.category_axioms gg'
]
)
moreover obtain f f' a a' b'' b'''
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and "bb' = [b'', b''']β©β"
and f: "f : a β¦βop_cat π
'β b''"
and "f' : a' β¦ββ'β b'''"
by
(
elim cat_prod_2_is_arrE[
OF π.HomDom.category_op π.HomDom.category_axioms ff'
]
)
ultimately have f: "f : a β¦βop_cat π
'β b" and f': "f' : a' β¦ββ'β b'"
by auto
from assms f f' g g' have [cat_cs_simps]:
"[
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦,
πβ¦ArrMapβ¦β¦g'β¦ ββ©Aβββ πβ¦ArrMapβ¦β¦f'β¦
]β©β =
[πβ¦ArrMapβ¦β¦gβ¦, πβ¦ArrMapβ¦β¦g'β¦]β©β ββ©Aβop_cat π
Γβ©C ββ
[πβ¦ArrMapβ¦β¦fβ¦, πβ¦ArrMapβ¦β¦f'β¦]β©β"
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from assms f f' g g' show ?thesis
unfolding gg'_def ff'_def aa'_def bb'_def cc'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"cf_cn_cov_bcomp π π πβ¦ArrMapβ¦β¦(op_cat π
' Γβ©C β')β¦CIdβ¦β¦cc'β¦β¦ =
πβ¦CIdβ¦β¦cf_cn_cov_bcomp π π πβ¦ObjMapβ¦β¦cc'β¦β¦"
if "cc' ββ©β (op_cat π
' Γβ©C β')β¦Objβ¦" for cc'
proof-
from that obtain c c'
where cc'_def: "cc' = [c, c']β©β"
and c: "c ββ©β op_cat π
'β¦Objβ¦"
and c': "c' ββ©β β'β¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2])
(auto intro: cat_cs_intros)
from assms c c' have [cat_cs_simps]:
"[π
β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦, ββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦c'β¦β¦]β©β =
(op_cat π
Γβ©C β)β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦, πβ¦ObjMapβ¦β¦c'β¦β¦β©β"
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from assms c c' show ?thesis
unfolding cc'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_cn_cov_bcomp_components cat_cs_simps intro: cat_cs_intros)
qed
lemma cf_cn_cov_bcomp_is_functor'[cat_cs_intros]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "π' = op_cat π
' Γβ©C β'"
shows "cf_cn_cov_bcomp π π π : π' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_bcomp_is_functor)
subsubsectionβΉProjection of a contracovariant bifunctor and functorsβΊ
lemma cf_cn_cov_bcomp_bifunctor_proj_snd[cat_cs_simps]:
assumes "π : π
' β¦β¦β©CβΞ±β π
"
and "π : β' β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "b ββ©β π
'β¦Objβ¦"
shows
"cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F =
(πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π"
proof(rule cf_eqI)
from assms show [intro]:
"cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F : β' β¦β¦β©CβΞ±β π"
"(πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π : β' β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
from assms have ObjMap_dom_lhs:
"πβ©β ((cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ObjMapβ¦) = β'β¦Objβ¦"
and ObjMap_dom_rhs:
"πβ©β (((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ObjMapβ¦) = β'β¦Objβ¦"
and ArrMap_dom_lhs:
"πβ©β ((cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ArrMapβ¦) = β'β¦Arrβ¦"
and ArrMap_dom_rhs:
"πβ©β (((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ArrMapβ¦) = β'β¦Arrβ¦"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cs_simp: cat_cs_simps)+
show
"(cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ObjMapβ¦ =
((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume "a ββ©β β'β¦Objβ¦"
with assms show
"(cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ =
((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto intro: is_functor.cf_ObjMap_vsv)
show
"(cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ArrMapβ¦ =
((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume "f ββ©β β'β¦Arrβ¦"
then obtain a' b' where "f : a' β¦ββ'β b'" by (auto intro: is_arrI)
with assms show
"(cf_cn_cov_bcomp π π πβop_cat π
',β'β(b,-)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ =
((πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F) ββ©Cβ©F π)β¦ArrMapβ¦β¦fβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto intro: is_functor.cf_ArrMap_vsv)
qed simp_all
subsectionβΉComposition of a covariant bifunctor and a covariant functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_lcomp :: "V β V β V β V"
where "cf_lcomp β π π = cf_bcomp π π (cf_id β)"
definition cf_rcomp :: "V β V β V β V"
where "cf_rcomp π
π π = cf_bcomp π (cf_id π
) π"
textβΉComponents.βΊ
lemma cf_lcomp_components:
shows "cf_lcomp β π πβ¦HomDomβ¦ = πβ¦HomDomβ¦ Γβ©C β"
and "cf_lcomp β π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_lcomp_def cf_bcomp_components dghm_id_components by simp_all
lemma cf_rcomp_components:
shows "cf_rcomp π
π πβ¦HomDomβ¦ = π
Γβ©C πβ¦HomDomβ¦"
and "cf_rcomp π
π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_rcomp_def cf_bcomp_components dghm_id_components by simp_all
subsubsectionβΉObject mapβΊ
lemma cf_lcomp_ObjMap_vsv: "vsv (cf_lcomp β π πβ¦ObjMapβ¦)"
unfolding cf_lcomp_def by (rule cf_bcomp_ObjMap_vsv)
lemma cf_rcomp_ObjMap_vsv: "vsv (cf_rcomp β π πβ¦ObjMapβ¦)"
unfolding cf_rcomp_def by (rule cf_bcomp_ObjMap_vsv)
lemma cf_lcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β (cf_lcomp β π πβ¦ObjMapβ¦) = (π Γβ©C β)β¦Objβ¦"
using assms
unfolding cf_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_rcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π
" and "π : π β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_rcomp π
π πβ¦ObjMapβ¦) = (π
Γβ©C π)β¦Objβ¦"
using assms
unfolding cf_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_lcomp_ObjMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "a ββ©β πβ¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "cf_lcomp β π πβ¦ObjMapβ¦β¦a, cβ¦β©β = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, cβ¦β©β"
using assms
unfolding cf_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
lemma cf_rcomp_ObjMap_app[cat_cs_simps]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
shows "cf_rcomp π
π πβ¦ObjMapβ¦β¦b, aβ¦β©β = πβ¦ObjMapβ¦β¦b, πβ¦ObjMapβ¦β¦aβ¦β¦β©β"
using assms
unfolding cf_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
lemma cf_lcomp_ObjMap_vrange:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_lcomp β π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
using assms
unfolding cf_lcomp_def
by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
lemma cf_rcomp_ObjMap_vrange:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_rcomp π
π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
using assms
unfolding cf_rcomp_def
by (intro cf_bcomp_ObjMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
subsubsectionβΉArrow mapβΊ
lemma cf_lcomp_ArrMap_vsv: "vsv (cf_lcomp β π πβ¦ArrMapβ¦)"
unfolding cf_lcomp_def by (rule cf_bcomp_ArrMap_vsv)
lemma cf_rcomp_ArrMap_vsv: "vsv (cf_rcomp π
π πβ¦ArrMapβ¦)"
unfolding cf_rcomp_def by (rule cf_bcomp_ArrMap_vsv)
lemma cf_lcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β (cf_lcomp β π πβ¦ArrMapβ¦) = (π Γβ©C β)β¦Arrβ¦"
using assms
unfolding cf_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_rcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π
" and "π : π β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_rcomp π
π πβ¦ArrMapβ¦) = (π
Γβ©C π)β¦Arrβ¦"
using assms
unfolding cf_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_lcomp_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "f ββ©β πβ¦Arrβ¦"
and "g ββ©β ββ¦Arrβ¦"
shows "cf_lcomp β π πβ¦ArrMapβ¦β¦f, gβ¦β©β = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦, gβ¦β©β"
using assms
unfolding cf_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
lemma cf_rcomp_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "f ββ©β π
β¦Arrβ¦"
and "g ββ©β πβ¦Arrβ¦"
shows "cf_rcomp π
π πβ¦ArrMapβ¦β¦f, gβ¦β©β = πβ¦ArrMapβ¦β¦f, πβ¦ArrMapβ¦β¦gβ¦β¦β©β"
using assms
unfolding cf_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
lemma cf_lcomp_ArrMap_vrange:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_lcomp β π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
using assms
unfolding cf_lcomp_def
by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
lemma cf_rcomp_ArrMap_vrange:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_rcomp π
π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
using assms
unfolding cf_rcomp_def
by (intro cf_bcomp_ArrMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
subsubsectionβΉ
Composition of a covariant bifunctor and a covariant functor is a functor
βΊ
lemma cf_lcomp_is_functor:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_lcomp β π π : π Γβ©C β β¦β¦β©CβΞ±β π"
using assms
unfolding cf_lcomp_def
by (cs_concl cs_intro: cat_cs_intros)+
lemma cf_lcomp_is_functor'[cat_cs_intros]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
and "π' = π Γβ©C β"
shows "cf_lcomp β π π : π' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_lcomp_is_functor)
lemma cf_rcomp_is_functor:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_rcomp π
π π : π
Γβ©C π β¦β¦β©CβΞ±β π"
using assms
unfolding cf_rcomp_def
by (cs_concl cs_intro: cat_cs_intros)+
lemma cf_rcomp_is_functor'[cat_cs_intros]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : π
Γβ©C β β¦β¦β©CβΞ±β π"
and "π' = π
Γβ©C π"
shows "cf_rcomp π
π π : π' β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_rcomp_is_functor)
subsectionβΉComposition of a contracovariant bifunctor and a covariant functorβΊ
definition cf_cn_cov_lcomp :: "V β V β V β V"
where "cf_cn_cov_lcomp β π π = cf_cn_cov_bcomp π π (cf_id β)"
definition cf_cn_cov_rcomp :: "V β V β V β V"
where "cf_cn_cov_rcomp π
π π = cf_cn_cov_bcomp π (cf_id π
) π"
textβΉComponents.βΊ
lemma cf_cn_cov_lcomp_components:
shows "cf_cn_cov_lcomp β π πβ¦HomDomβ¦ = op_cat (πβ¦HomDomβ¦) Γβ©C β"
and "cf_cn_cov_lcomp β π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_cn_cov_lcomp_def cf_cn_cov_bcomp_components dghm_id_components
by simp_all
lemma cf_cn_cov_rcomp_components:
shows "cf_cn_cov_rcomp π
π πβ¦HomDomβ¦ = op_cat π
Γβ©C πβ¦HomDomβ¦"
and "cf_cn_cov_rcomp π
π πβ¦HomCodβ¦ = πβ¦HomCodβ¦"
unfolding cf_cn_cov_rcomp_def cf_cn_cov_bcomp_components dghm_id_components
by simp_all
subsubsectionβΉObject mapβΊ
lemma cf_cn_cov_lcomp_ObjMap_vsv: "vsv (cf_cn_cov_lcomp β π πβ¦ObjMapβ¦)"
unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)
lemma cf_cn_cov_rcomp_ObjMap_vsv: "vsv (cf_cn_cov_rcomp β π πβ¦ObjMapβ¦)"
unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)
lemma cf_cn_cov_lcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β (cf_cn_cov_lcomp β π πβ¦ObjMapβ¦) = (op_cat π Γβ©C β)β¦Objβ¦"
using assms
unfolding cf_cn_cov_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_cn_cov_rcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π
" and "π : π β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_cn_cov_rcomp π
π πβ¦ObjMapβ¦) = (op_cat π
Γβ©C π)β¦Objβ¦"
using assms
unfolding cf_cn_cov_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_cn_cov_lcomp_ObjMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "a ββ©β op_cat πβ¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "cf_cn_cov_lcomp β π πβ¦ObjMapβ¦β¦a, cβ¦β©β = πβ¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, cβ¦β©β"
using assms
unfolding cf_cn_cov_lcomp_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemma cf_cn_cov_rcomp_ObjMap_app[cat_cs_simps]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "b ββ©β op_cat π
β¦Objβ¦"
and "a ββ©β πβ¦Objβ¦"
shows "cf_cn_cov_rcomp π
π πβ¦ObjMapβ¦β¦b, aβ¦β©β = πβ¦ObjMapβ¦β¦b, πβ¦ObjMapβ¦β¦aβ¦β¦β©β"
using assms
unfolding cf_cn_cov_rcomp_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemma cf_cn_cov_lcomp_ObjMap_vrange:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_lcomp β π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
using assms
unfolding cf_cn_cov_lcomp_def
by (intro cf_cn_cov_bcomp_ObjMap_vrange)
(cs_concl cs_intro: cat_cs_intros)+
lemma cf_cn_cov_rcomp_ObjMap_vrange:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_rcomp π
π πβ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
using assms
unfolding cf_cn_cov_rcomp_def
by (intro cf_cn_cov_bcomp_ObjMap_vrange)
(cs_concl cs_intro: cat_cs_intros)+
subsubsectionβΉArrow mapβΊ
lemma cf_cn_cov_lcomp_ArrMap_vsv: "vsv (cf_cn_cov_lcomp β π πβ¦ArrMapβ¦)"
unfolding cf_cn_cov_lcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)
lemma cf_cn_cov_rcomp_ArrMap_vsv: "vsv (cf_cn_cov_rcomp π
π πβ¦ArrMapβ¦)"
unfolding cf_cn_cov_rcomp_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)
lemma cf_cn_cov_lcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π β¦β¦β©CβΞ±β π
"
shows "πβ©β (cf_cn_cov_lcomp β π πβ¦ArrMapβ¦) = (op_cat π Γβ©C β)β¦Arrβ¦"
using assms
unfolding cf_cn_cov_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_cn_cov_rcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π
" and "π : π β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_cn_cov_rcomp π
π πβ¦ArrMapβ¦) = (op_cat π
Γβ©C π)β¦Arrβ¦"
using assms
unfolding cf_cn_cov_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_cn_cov_lcomp_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "f ββ©β op_cat πβ¦Arrβ¦"
and "g ββ©β ββ¦Arrβ¦"
shows "cf_cn_cov_lcomp β π πβ¦ArrMapβ¦β¦f, gβ¦β©β = πβ¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦, gβ¦β©β"
using assms
unfolding cf_cn_cov_lcomp_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemma cf_cn_cov_rcomp_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "f ββ©β op_cat π
β¦Arrβ¦"
and "g ββ©β πβ¦Arrβ¦"
shows "cf_cn_cov_rcomp π
π πβ¦ArrMapβ¦β¦f, gβ¦β©β = πβ¦ArrMapβ¦β¦f, πβ¦ArrMapβ¦β¦gβ¦β¦β©β"
using assms
unfolding cf_cn_cov_rcomp_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemma cf_cn_cov_lcomp_ArrMap_vrange:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_lcomp β π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
using assms
unfolding cf_cn_cov_lcomp_def
by (intro cf_cn_cov_bcomp_ArrMap_vrange)
(cs_concl cs_intro: cat_cs_intros)+
lemma cf_cn_cov_rcomp_ArrMap_vrange:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "ββ©β (cf_cn_cov_rcomp π
π πβ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
using assms
unfolding cf_cn_cov_rcomp_def cat_op_simps
by (intro cf_cn_cov_bcomp_ArrMap_vrange)
(cs_concl cs_intro: cat_cs_intros)+
subsubsectionβΉ
Composition of a contracovariant bifunctor and a covariant functor is a functor
βΊ
lemma cf_cn_cov_lcomp_is_functor:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_cn_cov_lcomp β π π : op_cat π Γβ©C β β¦β¦β©CβΞ±β π"
using assms
unfolding cf_cn_cov_lcomp_def cat_op_simps
by (cs_concl cs_intro: cat_cs_intros)+
lemma cf_cn_cov_lcomp_is_functor'[cat_cs_intros]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "πβ = op_cat π Γβ©C β"
shows "cf_cn_cov_lcomp β π π : πβ β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_lcomp_is_functor)
lemma cf_cn_cov_rcomp_is_functor:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
shows "cf_cn_cov_rcomp π
π π : op_cat π
Γβ©C π β¦β¦β©CβΞ±β π"
using assms
unfolding cf_cn_cov_rcomp_def cat_op_simps
by (cs_concl cs_intro: cat_cs_intros)+
lemma cf_cn_cov_rcomp_is_functor'[cat_cs_intros]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "π
π = op_cat π
Γβ©C π"
shows "cf_cn_cov_rcomp π
π π : π
π β¦β¦β©CβΞ±β π"
using assms(1-3) unfolding assms(4) by (rule cf_cn_cov_rcomp_is_functor)
subsubsectionβΉ
Projection of a composition of a contracovariant bifunctor and a covariant
functor
βΊ
lemma cf_cn_cov_rcomp_bifunctor_proj_snd[cat_cs_simps]:
assumes "category Ξ± π
"
and "π : π β¦β¦β©CβΞ±β β"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "b ββ©β π
β¦Objβ¦"
shows
"cf_cn_cov_rcomp π
π πβop_cat π
,πβ(b,-)β©Cβ©F =
(πβop_cat π
,ββ(b,-)β©Cβ©F) ββ©Cβ©F π"
using assms
unfolding cf_cn_cov_rcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_cn_cov_lcomp_bifunctor_proj_snd[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π β¦β¦β©CβΞ±β π
"
and "π : op_cat π
Γβ©C β β¦β¦β©CβΞ±β π"
and "b ββ©β πβ¦Objβ¦"
shows
"cf_cn_cov_lcomp β π πβop_cat π,ββ(b,-)β©Cβ©F =
(πβop_cat π
,ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β©Cβ©F)"
using assms
unfolding cf_cn_cov_lcomp_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
subsectionβΉComposition of bifunctorsβΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
definition cf_blcomp :: "V β V"
where "cf_blcomp π =
cf_lcomp (πβ¦HomCodβ¦) π π ββ©Cβ©F
cf_cat_prod_21_of_3 (πβ¦HomCodβ¦) (πβ¦HomCodβ¦) (πβ¦HomCodβ¦)"
definition cf_brcomp :: "V β V"
where "cf_brcomp π =
cf_rcomp (πβ¦HomCodβ¦) π π ββ©Cβ©F
cf_cat_prod_12_of_3 (πβ¦HomCodβ¦) (πβ¦HomCodβ¦) (πβ¦HomCodβ¦)"
textβΉAlternative forms of the definitions.βΊ
lemma cf_blcomp_def':
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "cf_blcomp π = cf_lcomp β π π ββ©Cβ©F cf_cat_prod_21_of_3 β β β"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
show ?thesis
by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def cs_intro: cat_cs_intros)
qed
lemma cf_brcomp_def':
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "cf_brcomp π = cf_rcomp β π π ββ©Cβ©F cf_cat_prod_12_of_3 β β β"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
show ?thesis
by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def cs_intro: cat_cs_intros)
qed
subsubsectionβΉCompositions of bifunctors are functorsβΊ
lemma cf_blcomp_is_functor:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "cf_blcomp π : β Γβ©Cβ©3 β Γβ©Cβ©3 β β¦β¦β©CβΞ±β β"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
show ?thesis
by (cs_concl cs_simp: cat_cs_simps cf_blcomp_def' cs_intro: cat_cs_intros)
qed
lemma cf_blcomp_is_functor'[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β" and "π' = β Γβ©Cβ©3 β Γβ©Cβ©3 β"
shows "cf_blcomp π : π' β¦β¦β©CβΞ±β β"
using assms(1) unfolding assms(2) by (rule cf_blcomp_is_functor)
lemma cf_brcomp_is_functor:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "cf_brcomp π : β Γβ©Cβ©3 β Γβ©Cβ©3 β β¦β¦β©CβΞ±β β"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
show ?thesis
by (cs_concl cs_simp: cat_cs_simps cf_brcomp_def' cs_intro: cat_cs_intros)
qed
lemma cf_brcomp_is_functor'[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β" and "π' = β Γβ©Cβ©3 β Γβ©Cβ©3 β"
shows "cf_brcomp π : π' β¦β¦β©CβΞ±β β"
using assms(1) unfolding assms(2) by (rule cf_brcomp_is_functor)
subsubsectionβΉObject mapβΊ
lemma cf_blcomp_ObjMap_vsv[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "vsv (cf_blcomp πβ¦ObjMapβ¦)"
proof-
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms])
show ?thesis by auto
qed
lemma cf_brcomp_ObjMap_vsv[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "vsv (cf_brcomp πβ¦ObjMapβ¦)"
proof-
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms])
show ?thesis by auto
qed
lemma cf_blcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_blcomp πβ¦ObjMapβ¦) = (β Γβ©Cβ©3 β Γβ©Cβ©3 β)β¦Objβ¦"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms])
show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma cf_brcomp_ObjMap_vdomain[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_brcomp πβ¦ObjMapβ¦) = (β Γβ©Cβ©3 β Γβ©Cβ©3 β)β¦Objβ¦"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms])
show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma cf_blcomp_ObjMap_app[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
and "A = [a, b, c]β©β"
and "a ββ©β ββ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "cf_blcomp πβ¦ObjMapβ¦β¦Aβ¦ = (a ββ©Hβ©Mβ©.β©Oβπβ b) ββ©Hβ©Mβ©.β©Oβπβ c"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms(1)])
from assms(3-5) show ?thesis
unfolding assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def'
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma cf_brcomp_ObjMap_app[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
and "A = [a, b, c]β©β"
and "a ββ©β ββ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "cf_brcomp πβ¦ObjMapβ¦β¦Aβ¦ = a ββ©Hβ©Mβ©.β©Oβπβ (b ββ©Hβ©Mβ©.β©Oβπβ c)"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms(1)])
from assms(3-5) show ?thesis
unfolding assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
subsubsectionβΉArrow mapβΊ
lemma cf_blcomp_ArrMap_vsv[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "vsv (cf_blcomp πβ¦ArrMapβ¦)"
proof-
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms])
show ?thesis by auto
qed
lemma cf_brcomp_ArrMap_vsv[cat_cs_intros]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "vsv (cf_brcomp πβ¦ArrMapβ¦)"
proof-
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms])
show ?thesis by auto
qed
lemma cf_blcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_blcomp πβ¦ArrMapβ¦) = (β Γβ©Cβ©3 β Γβ©Cβ©3 β)β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms])
show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma cf_brcomp_ArrMap_vdomain[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
shows "πβ©β (cf_brcomp πβ¦ArrMapβ¦) = (β Γβ©Cβ©3 β Γβ©Cβ©3 β)β¦Arrβ¦"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms])
show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma cf_blcomp_ArrMap_app[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
and "F = [h, g, f]β©β"
and "h ββ©β ββ¦Arrβ¦"
and "g ββ©β ββ¦Arrβ¦"
and "f ββ©β ββ¦Arrβ¦"
shows "cf_blcomp πβ¦ArrMapβ¦β¦Fβ¦ = (h ββ©Hβ©Mβ©.β©Aβπβ g) ββ©Hβ©Mβ©.β©Aβπβ f"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_blcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_blcomp πβΊ
by (rule cf_blcomp_is_functor[OF assms(1)])
from assms(3-5) show ?thesis
unfolding assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cf_blcomp_def'
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma cf_brcomp_ArrMap_app[cat_cs_simps]:
assumes "π : β Γβ©C β β¦β¦β©CβΞ±β β"
and "F = [h, g, f]β©β"
and "h ββ©β ββ¦Arrβ¦"
and "g ββ©β ββ¦Arrβ¦"
and "f ββ©β ββ¦Arrβ¦"
shows "cf_brcomp πβ¦ArrMapβ¦β¦Fβ¦ = h ββ©Hβ©Mβ©.β©Aβπβ (g ββ©Hβ©Mβ©.β©Aβπβ f)"
proof-
interpret π: is_functor Ξ± βΉβ Γβ©C ββΊ β π by (rule assms)
interpret cf_brcomp: is_functor Ξ± βΉβ Γβ©Cβ©3 β Γβ©Cβ©3 ββΊ β βΉcf_brcomp πβΊ
by (rule cf_brcomp_is_functor[OF assms(1)])
from assms(3-5) show ?thesis
unfolding assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cf_brcomp_def'
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
subsectionβΉBinatural transformationβΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
textβΉ
In this work, a βΉbinatural transformationβΊ is used to denote a natural
transformation of bifunctors.
βΊ
definition bnt_proj_fst :: "V β V β V β V β V"
(βΉ(_β_,_β/'(/-,_/')/β©Nβ©Tβ©Cβ©F)βΊ [51, 51, 51, 51] 51)
where "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F =
[
(Ξ»aββ©βπβ¦Objβ¦. πβ¦NTMapβ¦β¦a, bβ¦β©β),
πβ¦NTDomβ¦βπ,π
β(-,b)β©Cβ©F,
πβ¦NTCodβ¦βπ,π
β(-,b)β©Cβ©F,
π,
πβ¦NTDGCodβ¦
]β©β"
definition bnt_proj_snd :: "V β V β V β V β V"
(βΉ(_β_,_β/'(/_,-/')/β©Nβ©Tβ©Cβ©F)βΊ [51, 51, 51, 51] 51)
where "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F =
[
(Ξ»bββ©βπ
β¦Objβ¦. πβ¦NTMapβ¦β¦a, bβ¦β©β),
πβ¦NTDomβ¦βπ,π
β(a,-)β©Cβ©F,
πβ¦NTCodβ¦βπ,π
β(a,-)β©Cβ©F,
π
,
πβ¦NTDGCodβ¦
]β©β"
textβΉComponentsβΊ
lemma bnt_proj_fst_components:
shows "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦ = (Ξ»aββ©βπβ¦Objβ¦. πβ¦NTMapβ¦β¦a, bβ¦β©β)"
and "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTDomβ¦ = πβ¦NTDomβ¦βπ,π
β(-,b)β©Cβ©F"
and "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTCodβ¦ = πβ¦NTCodβ¦βπ,π
β(-,b)β©Cβ©F"
and "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTDGDomβ¦ = π"
and "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTDGCodβ¦ = πβ¦NTDGCodβ¦"
unfolding bnt_proj_fst_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma bnt_proj_snd_components:
shows "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦ = (Ξ»bββ©βπ
β¦Objβ¦. πβ¦NTMapβ¦β¦a, bβ¦β©β)"
and "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTDomβ¦ = πβ¦NTDomβ¦βπ,π
β(a,-)β©Cβ©F"
and "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTCodβ¦ = πβ¦NTCodβ¦βπ,π
β(a,-)β©Cβ©F"
and "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTDGDomβ¦ = π
"
and "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTDGCodβ¦ = πβ¦NTDGCodβ¦"
unfolding bnt_proj_snd_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapsβΊ
mk_VLambda bnt_proj_fst_components(1)[folded VLambda_vconst_on]
|vsv bnt_proj_fst_NTMap_vsv[cat_cs_intros]|
|vdomain bnt_proj_fst_NTMap_vdomain[cat_cs_simps]|
|app bnt_proj_fst_NTMap_app[cat_cs_simps]|
lemma bnt_proj_fst_vrange:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "ββ©β ((πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
unfolding bnt_proj_fst_components
proof(rule vrange_VLambda_vsubset)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms show "πβ¦NTMapβ¦β¦a, bβ¦β©β ββ©β ββ¦Arrβ¦"
by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
qed
mk_VLambda bnt_proj_snd_components(1)[folded VLambda_vconst_on]
|vsv bnt_proj_snd_NTMap_vsv[intro]|
|vdomain bnt_proj_snd_NTMap_vdomain[cat_cs_simps]|
|app bnt_proj_snd_NTMap_app[cat_cs_simps]|
lemma bnt_proj_snd_vrange:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
shows "ββ©β ((πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) ββ©β ββ¦Arrβ¦"
proof-
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
unfolding bnt_proj_snd_components
proof(rule vrange_VLambda_vsubset)
fix b assume "b ββ©β π
β¦Objβ¦"
with assms show "πβ¦NTMapβ¦β¦a, bβ¦β©β ββ©β ββ¦Arrβ¦"
by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
qed
subsubsectionβΉBinatural transformation projection is a natural transformationβΊ
lemma bnt_proj_snd_is_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
shows "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F : πβπ,π
β(a,-)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)" unfolding bnt_proj_snd_def by simp
show "vcard (πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F) = 5β©β"
unfolding bnt_proj_snd_def by (simp add: nat_omega_simps)
from assms show "πβπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms show "π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦bβ¦ :
(πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦ β¦βββ (π'βπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" for b
using that assms
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
show "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦bβ¦ ββ©Aβββ (πβπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ =
(π'βπ,π
β(a,-)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ (πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦a'β¦"
if "f : a' β¦βπ
β b" for a' b f
using that assms
by
(
cs_concl
cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (auto simp: bnt_proj_snd_components cat_cs_simps)
qed
lemma bnt_proj_snd_is_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "π = πβπ,π
β(a,-)β©Cβ©F"
and "π = π'βπ,π
β(a,-)β©Cβ©F"
shows "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
using assms by (auto intro: bnt_proj_snd_is_ntcf)
lemma bnt_proj_fst_is_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F : πβπ,π
β(-,b)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)" unfolding bnt_proj_fst_def by simp
show "vcard (πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F) = 5β©β"
unfolding bnt_proj_fst_def by (simp add: nat_omega_simps)
from assms show "πβπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦ :
(πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ β¦βββ (π'βπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using that assms
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
show "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦b'β¦ ββ©Aβββ (πβπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ =
(π'βπ,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ ββ©Aβββ (πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπβ b'" for a b' f
using that assms
by
(
cs_concl
cs_simp: is_ntcf.ntcf_Comp_commute cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed (auto simp: bnt_proj_fst_components cat_cs_simps)
qed
lemma bnt_proj_fst_is_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
and "π = πβπ,π
β(-,b)β©Cβ©F"
and "π = π'βπ,π
β(-,b)β©Cβ©F"
and "π' = π"
shows "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F : π β¦β©Cβ©F π : π' β¦β¦β©CβΞ±β β"
using assms(1-4) unfolding assms(5-7) by (rule bnt_proj_fst_is_ntcf)
subsubsectionβΉArray binatural transformation is a natural transformationβΊ
lemma ntcf_array_is_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "vfsequence π"
and "vcard π = 5β©β"
and "πβ¦NTDomβ¦ = π"
and "πβ¦NTCodβ¦ = π'"
and "πβ¦NTDGDomβ¦ = π Γβ©C π
"
and "πβ¦NTDGCodβ¦ = β"
and "vsv (πβ¦NTMapβ¦)"
and "πβ©β (πβ¦NTMapβ¦) = (π Γβ©C π
)β¦Objβ¦"
and "βa b. β¦ a ββ©β πβ¦Objβ¦; b ββ©β π
β¦Objβ¦ β§ βΉ
πβ¦NTMapβ¦β¦a, bβ¦β©β : πβ¦ObjMapβ¦β¦a, bβ¦β©β β¦βββ π'β¦ObjMapβ¦β¦a, bβ¦β©β"
and "βa. a ββ©β πβ¦Objβ¦ βΉ
πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F : πβπ,π
β(a,-)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
and "βb. b ββ©β π
β¦Objβ¦ βΉ
πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F : πβπ,π
β(-,b)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
shows "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: vsv βΉπβ¦NTMapβ¦βΊ by (rule assms(11))
have [cat_cs_intros]:
"β¦ a ββ©β πβ¦Objβ¦; b ββ©β π
β¦Objβ¦; A = πβ¦ObjMapβ¦β¦a, bβ¦β©β; B = π'β¦ObjMapβ¦β¦a, bβ¦β©β β§ βΉ
πβ¦NTMapβ¦β¦a, bβ¦β©β : A β¦βββ B"
for a b A B
by (auto intro: assms(13))
show ?thesis
proof(intro is_ntcfI')
show "πβ¦NTMapβ¦β¦abβ¦ : πβ¦ObjMapβ¦β¦abβ¦ β¦βββ π'β¦ObjMapβ¦β¦abβ¦"
if "ab ββ©β (π Γβ©C π
)β¦Objβ¦" for ab
proof-
from that obtain a b
where ab_def: "ab = [a, b]β©β" and a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
from a b show ?thesis unfolding ab_def by (rule assms(13))
qed
show
"πβ¦NTMapβ¦β¦a'b'β¦ ββ©Aβββ πβ¦ArrMapβ¦β¦gfβ¦ = π'β¦ArrMapβ¦β¦gfβ¦ ββ©Aβββ πβ¦NTMapβ¦β¦abβ¦"
if "gf : ab β¦βπ Γβ©C π
β a'b'" for ab a'b' gf
proof-
from that obtain g f a b a' b'
where gf_def: "gf = [g, f]β©β"
and ab_def: "ab = [a, b]β©β"
and a'b'_def: "a'b' = [a', b']β©β"
and g: "g : a β¦βπβ a'"
and f: "f : b β¦βπ
β b'"
by (elim cat_prod_2_is_arrE[OF assms(1,2)])
then have a: "a ββ©β πβ¦Objβ¦"
and a': "a' ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
and b': "b' ββ©β π
β¦Objβ¦"
by auto
show ?thesis
unfolding gf_def ab_def a'b'_def
proof-
from is_ntcfD'(13)[OF assms(15)[OF b] g] g f assms(1,2,3,4)
have [cat_cs_simps]:
"(π'β¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β ββ©Aβββ πβ¦NTMapβ¦β¦a, bβ¦β©β) =
(πβ¦NTMapβ¦β¦a', bβ¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β)"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
from is_ntcfD'(13)[OF assms(14)[OF a'] f] g f assms(1,2)
have π'π:
"π'β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ πβ¦NTMapβ¦β¦a', bβ¦β©β =
πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦,fβ¦β©β"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) auto
from g f assms(1-4) have [cat_cs_simps]:
"π'β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ (πβ¦NTMapβ¦β¦a', bβ¦β©β ββ©Aβββ q) =
πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ (πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦,fβ¦β©β ββ©Aβββ q)"
if "q : r β¦βββ πβ¦ObjMapβ¦β¦a', bβ¦β©β" for q r
using that
by
(
cs_concl
cs_simp: π'π category.cat_Comp_assoc[symmetric]
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from assms(1-4) g f have
"π'β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ π'β¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β =
π'β¦ArrMapβ¦β¦[πβ¦CIdβ¦β¦a'β¦, f]β©β ββ©Aβπ Γβ©C π
β [g, π
β¦CIdβ¦β¦bβ¦]β©ββ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1-4) g f have "β¦ = π'β¦ArrMapβ¦ β¦g, fβ¦β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
finally have π'_gf: "π'β¦ArrMapβ¦ β¦g, fβ¦β©β =
π'β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ π'β¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β"
by simp
from assms(1-4) g f have
"πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β =
πβ¦ArrMapβ¦β¦[πβ¦CIdβ¦β¦a'β¦, f]β©β ββ©Aβπ Γβ©C π
β [g, π
β¦CIdβ¦β¦bβ¦]β©ββ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1-4) g f have "β¦ = πβ¦ArrMapβ¦ β¦g, fβ¦β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
finally have π_gf: "πβ¦ArrMapβ¦β¦g, fβ¦β©β =
πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β"
by simp
from assms(1-4) g f assms(13)[OF a b] assms(13)[OF a' b] have
"π'β¦ArrMapβ¦β¦g, fβ¦β©β ββ©Aβββ πβ¦NTMapβ¦β¦a, bβ¦β©β =
(π'β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦, fβ¦β©β ββ©Aβββ πβ¦NTMapβ¦β¦a', bβ¦β©β) ββ©Aβββ
πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β"
unfolding π'_gf
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1-4) g f have
"β¦ = (πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦,fβ¦β©β) ββ©Aβββ
πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1-4) g f assms(13)[OF a' b'] have
"β¦ = πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ
(πβ¦ArrMapβ¦β¦πβ¦CIdβ¦β¦a'β¦,fβ¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, π
β¦CIdβ¦β¦bβ¦β¦β©β)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1-4) g f assms(13)[OF a' b'] have
"β¦ = πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, fβ¦β©β"
unfolding π_gf[symmetric] by simp
finally show
"πβ¦NTMapβ¦β¦a', b'β¦β©β ββ©Aβββ πβ¦ArrMapβ¦β¦g, fβ¦β©β =
π'β¦ArrMapβ¦β¦g, fβ¦β©β ββ©Aβββ πβ¦NTMapβ¦β¦a, bβ¦β©β"
by simp
qed
qed
qed (auto simp: assms)
qed
subsubsectionβΉBinatural transformation projections and isomorphismsβΊ
lemma is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "βa. a ββ©β πβ¦Objβ¦ βΉ
πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F : πβπ,π
β(a,-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
shows "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
show ?thesis
proof(intro is_iso_ntcfI)
show "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β" by (rule assms(3))
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β" and a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
interpret πa: is_iso_ntcf
Ξ± π
β βΉπβπ,π
β(a,-)β©Cβ©FβΊ βΉπ'βπ,π
β(a,-)β©Cβ©FβΊ βΉπβπ,π
β(a,-)β©Nβ©Tβ©Cβ©FβΊ
by (rule assms(4)[OF a])
from b have πab: "πβ¦NTMapβ¦β¦a, bβ¦β©β = (πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦bβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from πa.iso_ntcf_is_arr_isomorphism[OF b] assms(1,2,3) a b show
"πβ¦NTMapβ¦β¦abβ¦ : πβ¦ObjMapβ¦β¦abβ¦ β¦β©iβ©sβ©oβββ π'β¦ObjMapβ¦β¦abβ¦"
by (cs_prems cs_simp: cat_cs_simps ab_def cs_intro: cat_prod_cs_intros)
qed
qed
lemma is_iso_ntcf_if_bnt_proj_fst_is_iso_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "βb. b ββ©β π
β¦Objβ¦ βΉ
πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F : πβπ,π
β(-,b)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
shows "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
show ?thesis
proof(intro is_iso_ntcfI)
show "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β" by (rule assms(3))
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β" and a: "a ββ©β πβ¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
interpret πa: is_iso_ntcf
Ξ± π β βΉπβπ,π
β(-,b)β©Cβ©FβΊ βΉπ'βπ,π
β(-,b)β©Cβ©FβΊ βΉπβπ,π
β(-,b)β©Nβ©Tβ©Cβ©FβΊ
by (rule assms(4)[OF b])
from b have πab: "πβ¦NTMapβ¦β¦a, bβ¦β©β = (πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦bβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from πa.iso_ntcf_is_arr_isomorphism[OF a] assms(1,2,3) a b show
"πβ¦NTMapβ¦β¦abβ¦ : πβ¦ObjMapβ¦β¦abβ¦ β¦β©iβ©sβ©oβββ π'β¦ObjMapβ¦β¦abβ¦"
unfolding ab_def
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
qed
qed
lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
shows "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F :
πβπ,π
β(a,-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
proof(intro is_iso_ntcfI)
from assms show "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F :
πβπ,π
β(a,-)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(a,-)β©Cβ©F : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
show "(πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦bβ¦ :
(πβπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦ β¦β©iβ©sβ©oβββ (π'βπ,π
β(a,-)β©Cβ©F)β¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" for b
using assms that
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
)
qed
lemma bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π = πβπ,π
β(a,-)β©Cβ©F"
and "π = π'βπ,π
β(a,-)β©Cβ©F"
and "π
' = π
"
and "a ββ©β πβ¦Objβ¦"
shows "πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
' β¦β¦β©CβΞ±β β"
unfolding assms(4-6)
by (rule bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])
lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F :
πβπ,π
β(-,b)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
proof(intro is_iso_ntcfI)
from assms show "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F :
πβπ,π
β(-,b)β©Cβ©F β¦β©Cβ©F π'βπ,π
β(-,b)β©Cβ©F : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
show "(πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦ :
(πβπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ β¦β©iβ©sβ©oβββ (π'βπ,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using assms that
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_prod_cs_intros cat_arrow_cs_intros
)
qed
lemma bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π = πβπ,π
β(-,b)β©Cβ©F"
and "π = π'βπ,π
β(-,b)β©Cβ©F"
and "π' = π"
and "b ββ©β π
β¦Objβ¦"
shows "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π' β¦β¦β©CβΞ±β β"
unfolding assms(4-6)
by (rule bnt_proj_fst_is_iso_ntcf_if_is_iso_ntcf[OF assms(1-3,7)])
subsectionβΉBinatural transformation flipβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition bnt_flip :: "V β V β V β V"
where "bnt_flip π π
π =
[
fflip (πβ¦NTMapβ¦),
bifunctor_flip π π
(πβ¦NTDomβ¦),
bifunctor_flip π π
(πβ¦NTCodβ¦),
π
Γβ©C π,
πβ¦NTDGCodβ¦
]β©β"
textβΉComponents.βΊ
lemma bnt_flip_components:
shows "bnt_flip π π
πβ¦NTMapβ¦ = fflip (πβ¦NTMapβ¦)"
and "bnt_flip π π
πβ¦NTDomβ¦ = bifunctor_flip π π
(πβ¦NTDomβ¦)"
and "bnt_flip π π
πβ¦NTCodβ¦ = bifunctor_flip π π
(πβ¦NTCodβ¦)"
and "bnt_flip π π
πβ¦NTDGDomβ¦ = π
Γβ©C π"
and "bnt_flip π π
πβ¦NTDGCodβ¦ = πβ¦NTDGCodβ¦"
unfolding bnt_flip_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π
β π π' π
assumes π: "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule π)
lemmas bnt_flip_components' =
bnt_flip_components[where π=π and π
=π
and π=π, unfolded cat_cs_simps]
lemmas [cat_cs_simps] = bnt_flip_components'(2-5)
end
subsubsectionβΉNatural transformation mapβΊ
lemma bnt_flip_NTMap_vsv[cat_cs_intros]: "vsv (bnt_flip π π
πβ¦NTMapβ¦)"
unfolding bnt_flip_components by (rule fflip_vsv)
lemma bnt_flip_NTMap_app:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "bnt_flip π π
πβ¦NTMapβ¦β¦b, aβ¦β©β = πβ¦NTMapβ¦β¦a, bβ¦β©β"
using assms
unfolding bnt_flip_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_prod_cs_intros)
lemma bnt_flip_NTMap_app'[cat_cs_simps]:
assumes "ba = [b, a]β©β"
and "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "bnt_flip π π
πβ¦NTMapβ¦β¦baβ¦ = πβ¦NTMapβ¦β¦a, bβ¦β©β"
using assms(2-6) unfolding assms(1) by (rule bnt_flip_NTMap_app)
lemma bnt_flip_NTMap_vdomain[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "πβ©β (bnt_flip π π
πβ¦NTMapβ¦) = (π
Γβ©C π)β¦Objβ¦"
using assms
unfolding bnt_flip_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps)
lemma bnt_flip_NTMap_vrange[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "ββ©β (bnt_flip π π
πβ¦NTMapβ¦) = ββ©β (πβ¦NTMapβ¦)"
proof-
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
proof(intro vsubset_antisym)
show "ββ©β (bnt_flip π π
πβ¦NTMapβ¦) ββ©β ββ©β (πβ¦NTMapβ¦)"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold bnt_flip_NTMap_vdomain[OF assms]
)
fix ba assume "ba ββ©β (π
Γβ©C π)β¦Objβ¦"
then obtain a b
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(2,1)])
from π.ntcf_NTMap_vsv assms a b show
"bnt_flip π π
πβ¦NTMapβ¦β¦baβ¦ ββ©β ββ©β (πβ¦NTMapβ¦)"
unfolding ba_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_prod_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
show "ββ©β (πβ¦NTMapβ¦) ββ©β ββ©β (bnt_flip π π
πβ¦NTMapβ¦)"
proof(intro vsv.vsv_vrange_vsubset, unfold π.ntcf_NTMap_vdomain)
fix ab assume prems: "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF assms(1,2)])
from assms a b have ba: "[b, a]β©β ββ©β (π
Γβ©C π)β¦Objβ¦"
by (cs_concl cs_intro: cat_prod_cs_intros)
from assms bnt_flip_NTMap_vsv prems a b ba show
"πβ¦NTMapβ¦β¦abβ¦ ββ©β ββ©β (bnt_flip π π
πβ¦NTMapβ¦)"
unfolding ab_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
qed auto
qed
qed
subsubsectionβΉBinatural transformation flip natural transformation mapβΊ
lemma bnt_flip_NTMap_is_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "bnt_flip π π
π :
bifunctor_flip π π
π β¦β©Cβ©F bifunctor_flip π π
π' :
π
Γβ©C π β¦β¦β©CβΞ±β β"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (bnt_flip π π
π)" unfolding bnt_flip_def by simp
show "vcard (bnt_flip π π
π) = 5β©β"
unfolding bnt_flip_def by (simp add: nat_omega_simps)
show "bnt_flip π π
πβ¦NTMapβ¦β¦baβ¦ :
bifunctor_flip π π
πβ¦ObjMapβ¦β¦baβ¦ β¦βββ
bifunctor_flip π π
π'β¦ObjMapβ¦β¦baβ¦"
if "ba ββ©β (π
Γβ©C π)β¦Objβ¦" for ba
proof-
from that obtain b a
where ba_def: "ba = [b, a]β©β"
and b: "b ββ©β π
β¦Objβ¦"
and a: "a ββ©β πβ¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
from assms a b show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps ba_def
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"bnt_flip π π
πβ¦NTMapβ¦β¦b'a'β¦ ββ©Aβββ bifunctor_flip π π
πβ¦ArrMapβ¦β¦gfβ¦ =
bifunctor_flip π π
π'β¦ArrMapβ¦β¦gfβ¦ ββ©Aβββ bnt_flip π π
πβ¦NTMapβ¦β¦baβ¦"
if "gf : ba β¦βπ
Γβ©C πβ b'a'" for ba b'a' gf
proof-
from that obtain g f a b a' b'
where gf_def: "gf = [g, f]β©β"
and ba_def: "ba = [b, a]β©β"
and b'a'_def: "b'a' = [b', a']β©β"
and g: "g : b β¦βπ
β b'"
and f: "f : a β¦βπβ a'"
by (elim cat_prod_2_is_arrE[OF assms(2,1)])
from assms g f show ?thesis
unfolding gf_def ba_def b'a'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_cs_simps π.ntcf_Comp_commute
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
qed (use assms in βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ)+
qed
lemma bnt_flip_NTMap_is_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π― = bifunctor_flip π π
π"
and "π―' = bifunctor_flip π π
π'"
and "π = π
Γβ©C π"
shows "bnt_flip π π
π : π― β¦β©Cβ©F π―' : π β¦β¦β©CβΞ±β β"
using assms(1-3) unfolding assms(4-6) by (intro bnt_flip_NTMap_is_ntcf)
subsubsectionβΉDouble-flip of a binatural transformationβΊ
lemma bnt_flip_flip[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "bnt_flip π
π (bnt_flip π π
π) = π"
proof(rule ntcf_eqI)
interpret π: category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
interpret π: is_ntcf Ξ± βΉπ Γβ©C π
βΊ β π π' π by (rule assms(3))
from assms show
"bnt_flip π
π (bnt_flip π π
π) : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have dom_lhs:
"πβ©β (bnt_flip π
π (bnt_flip π π
π)β¦NTMapβ¦) = (π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β" by (rule assms(3))
then have dom_rhs: "πβ©β (πβ¦NTMapβ¦) = (π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "bnt_flip π
π (bnt_flip π π
π)β¦NTMapβ¦ = πβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix ab assume "ab ββ©β (π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by (rule cat_prod_2_ObjE[OF assms(1,2)])
from assms a b show
"bnt_flip π
π (bnt_flip π π
π)β¦NTMapβ¦β¦abβ¦ = πβ¦NTMapβ¦β¦abβ¦"
by (cs_concl cs_simp: cat_cs_simps ab_def cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all
subsubsectionβΉA projection of a flip of a binatural transformationβΊ
lemma bnt_flip_proj_snd[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "bnt_flip π π
πβπ
,πβ(b,-)β©Nβ©Tβ©Cβ©F = πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F"
proof(rule ntcf_eqI)
from assms show "bnt_flip π π
πβπ
,πβ(b,-)β©Nβ©Tβ©Cβ©F :
bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F β¦β©Cβ©F bifunctor_flip π π
π'βπ
,πβ(b,-)β©Cβ©F :
π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F :
bifunctor_flip π π
πβπ
,πβ(b,-)β©Cβ©F β¦β©Cβ©F bifunctor_flip π π
π'βπ
,πβ(b,-)β©Cβ©F :
π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have dom_lhs:
"πβ©β ((bnt_flip π π
πβπ
,πβ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms have dom_rhs: "πβ©β ((πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "(bnt_flip π π
πβπ
,πβ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦ = (πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with assms show
"(bnt_flip π π
πβπ
,πβ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦ = (πβπ,π
β(-,b)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps)
qed (auto simp: cat_cs_intros)
qed simp_all
lemma bnt_flip_proj_fst[cat_cs_simps]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©F π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
shows "bnt_flip π π
πβπ
,πβ(-,a)β©Nβ©Tβ©Cβ©F = πβπ,π
β(a,-)β©Nβ©Tβ©Cβ©F"
proof-
from assms have f_π:
"bnt_flip π π
π :
bifunctor_flip π π
π β¦β©Cβ©F bifunctor_flip π π
π' :
π
Γβ©C π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
show ?thesis
by
(
rule
bnt_flip_proj_snd
[
OF assms(2,1) f_π assms(4),
unfolded bnt_flip_flip[OF assms(1,2,3)],
symmetric
]
)
qed
subsubsectionβΉA flip of a binatural isomorphismβΊ
lemma bnt_flip_is_iso_ntcf:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
shows "bnt_flip π π
π :
bifunctor_flip π π
π β¦β©Cβ©Fβ©.β©iβ©sβ©o bifunctor_flip π π
π' :
π
Γβ©C π β¦β¦β©CβΞ±β β"
proof(rule is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf)
from assms show f_π: "bnt_flip π π
π :
bifunctor_flip π π
π β¦β©Cβ©F bifunctor_flip π π
π' :
π
Γβ©C π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros ntcf_cs_intros)
fix a assume "a ββ©β π
β¦Objβ¦"
with assms f_π show
"bnt_flip π π
πβπ
,πβ(a,-)β©Nβ©Tβ©Cβ©F :
bifunctor_flip π π
πβπ
,πβ(a,-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o
bifunctor_flip π π
π'βπ
,πβ(a,-)β©Cβ©F :
π β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
qed (simp_all add: assms)
lemma bnt_flip_is_iso_ntcf'[cat_cs_intros]:
assumes "category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π Γβ©C π
β¦β¦β©CβΞ±β β"
and "π = bifunctor_flip π π
π"
and "π = bifunctor_flip π π
π'"
and "π = π
Γβ©C π"
shows "bnt_flip π π
π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β β"
using bnt_flip_is_iso_ntcf[OF assms(1-3)] unfolding assms(4-6) by simp
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Subcategory
sectionβΉSubcategoryβΊ
theory CZH_ECAT_Subcategory
imports
CZH_ECAT_Functor
CZH_Foundations.CZH_SMC_Subsemicategory
begin
subsectionβΉBackgroundβΊ
named_theorems cat_sub_cs_intros
named_theorems cat_sub_bw_cs_intros
named_theorems cat_sub_fw_cs_intros
named_theorems cat_sub_bw_cs_simps
subsectionβΉSimple subcategoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.βΊ
locale subcategory = sdg: category Ξ± π
+ dg: category Ξ± β for Ξ± π
β +
assumes subcat_subsemicategory: "cat_smc π
ββ©Sβ©Mβ©CβΞ±β cat_smc β"
and subcat_CId: "a ββ©β π
β¦Objβ¦ βΉ π
β¦CIdβ¦β¦aβ¦ = ββ¦CIdβ¦β¦aβ¦"
abbreviation is_subcategory ("(_/ ββ©CΔ± _)" [51, 51] 50)
where "π
ββ©CβΞ±β β β‘ subcategory Ξ± π
β"
textβΉRules.βΊ
lemma (in subcategory) subcategory_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±" and "π
' = π
"
shows "π
' ββ©CβΞ±'β β"
unfolding assms by (rule subcategory_axioms)
lemma (in subcategory) subcategory_axioms''[cat_cs_intros]:
assumes "Ξ±' = Ξ±" and "β' = β"
shows "π
ββ©CβΞ±'β β'"
unfolding assms by (rule subcategory_axioms)
mk_ide rf subcategory_def[unfolded subcategory_axioms_def]
|intro subcategoryI[intro!]|
|dest subcategoryD[dest]|
|elim subcategoryE[elim!]|
lemmas [cat_sub_cs_intros] = subcategoryD(1,2)
lemma subcategoryI':
assumes "category Ξ± π
"
and "category Ξ± β"
and "βa. a ββ©β π
β¦Objβ¦ βΉ a ββ©β ββ¦Objβ¦"
and "βa b f. f : a β¦βπ
β b βΉ f : a β¦βββ b"
and "βb c g a f. β¦ g : b β¦βπ
β c; f : a β¦βπ
β b β§ βΉ
g ββ©Aβπ
β f = g ββ©Aβββ f"
and "βa. a ββ©β π
β¦Objβ¦ βΉ π
β¦CIdβ¦β¦aβ¦ = ββ¦CIdβ¦β¦aβ¦"
shows "π
ββ©CβΞ±β β"
proof-
interpret π
: category Ξ± π
by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
show ?thesis
by
(
intro subcategoryI subsemicategoryI',
unfold slicing_simps;
(intro π
.cat_semicategory β.cat_semicategory assms)?
)
qed
textβΉA subcategory is a subsemicategory.βΊ
context subcategory
begin
interpretation subsmc: subsemicategory Ξ± βΉcat_smc π
βΊ βΉcat_smc ββΊ
by (rule subcat_subsemicategory)
lemmas_with [unfolded slicing_simps slicing_commute]:
subcat_Obj_vsubset = subsmc.subsmc_Obj_vsubset
and subcat_is_arr_vsubset = subsmc.subsmc_is_arr_vsubset
and subcat_subdigraph_op_dg_op_dg = subsmc.subsmc_subdigraph_op_dg_op_dg
and subcat_objD = subsmc.subsmc_objD
and subcat_arrD = subsmc.subsmc_arrD
and subcat_dom_simp = subsmc.subsmc_dom_simp
and subcat_cod_simp = subsmc.subsmc_cod_simp
and subcat_is_arrD = subsmc.subsmc_is_arrD
lemmas_with [unfolded slicing_simps slicing_commute]:
subcat_Comp_simp = subsmc.subsmc_Comp_simp
and subcat_is_idem_arrD = subsmc.subsmc_is_idem_arrD
end
lemmas [cat_sub_fw_cs_intros] =
subcategory.subcat_Obj_vsubset
subcategory.subcat_is_arr_vsubset
subcategory.subcat_objD
subcategory.subcat_arrD
subcategory.subcat_is_arrD
lemmas [cat_sub_bw_cs_simps] =
subcategory.subcat_dom_simp
subcategory.subcat_cod_simp
lemmas [cat_sub_fw_cs_intros] =
subcategory.subcat_is_idem_arrD
lemmas [cat_sub_bw_cs_simps] =
subcategory.subcat_Comp_simp
textβΉThe opposite subcategory.βΊ
lemma (in subcategory) subcat_subcategory_op_cat: "op_cat π
ββ©CβΞ±β op_cat β"
proof(rule subcategoryI)
show "cat_smc (op_cat π
) ββ©Sβ©Mβ©CβΞ±β cat_smc (op_cat β)"
unfolding slicing_commute[symmetric]
by (intro subsmc_subsemicategory_op_smc subcat_subsemicategory)
qed (simp_all add: sdg.category_op dg.category_op cat_op_simps subcat_CId)
lemmas subcat_subcategory_op_cat[intro] = subcategory.subcat_subcategory_op_cat
textβΉElementary properties.βΊ
lemma (in subcategory) subcat_CId_is_arr[intro]:
assumes "a ββ©β π
β¦Objβ¦"
shows "ββ¦CIdβ¦β¦aβ¦ : a β¦βπ
β a"
proof-
from assms have π
β: "π
β¦CIdβ¦β¦aβ¦ = ββ¦CIdβ¦β¦aβ¦" by (simp add: subcat_CId)
from assms have "π
β¦CIdβ¦β¦aβ¦ : a β¦βπ
β a" by (auto intro: cat_cs_intros)
then show ?thesis unfolding π
β by simp
qed
textβΉFurther rules.βΊ
lemma (in subcategory) subcat_CId_simp[cat_sub_bw_cs_simps]:
assumes "a ββ©β π
β¦Objβ¦"
shows "π
β¦CIdβ¦β¦aβ¦ = ββ¦CIdβ¦β¦aβ¦"
using assms by (simp add: subcat_CId)
lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_CId_simp
lemma (in subcategory) subcat_is_right_inverseD[cat_sub_fw_cs_intros]:
assumes "is_right_inverse π
g f"
shows "is_right_inverse β g f"
using assms subcategory_axioms
by (elim is_right_inverseE, intro is_right_inverseI)
(
cs_concl
cs_simp: cat_sub_bw_cs_simps[symmetric]
cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
)
lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_right_inverseD
lemma (in subcategory) subcat_is_left_inverseD[cat_sub_fw_cs_intros]:
assumes "is_left_inverse π
g f"
shows "is_left_inverse β g f"
proof-
have "op_cat π
ββ©CβΞ±β op_cat β" by (simp add: subcat_subcategory_op_cat)
from subcategory.subcat_is_right_inverseD[OF this] show ?thesis
unfolding cat_op_simps using assms.
qed
lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_left_inverseD
lemma (in subcategory) subcat_is_inverseD[cat_sub_fw_cs_intros]:
assumes "is_inverse π
g f"
shows "is_inverse β g f"
using assms subcategory_axioms
by (elim is_inverseE, intro is_inverseI)
(
cs_concl
cs_simp: cat_sub_bw_cs_simps[symmetric]
cs_intro: cat_sub_fw_cs_intros cat_cs_intros cat_sub_cs_intros
)
lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_inverseD
lemma (in subcategory) subcat_is_arr_isomorphismD[cat_sub_fw_cs_intros]:
assumes "f : a β¦β©iβ©sβ©oβπ
β b"
shows "f : a β¦β©iβ©sβ©oβββ b"
proof(intro is_arr_isomorphismI)
from subcategory_axioms is_arr_isomorphismD(1)[OF assms] show "f : a β¦βββ b"
by
(
cs_concl
cs_simp: cat_sub_bw_cs_simps[symmetric] cs_intro: cat_sub_fw_cs_intros
)
from assms have "is_inverse π
(fΒ―β©Cβπ
β) f"
by (rule sdg.cat_the_inverse_is_inverse)
with subcategory_axioms show "is_inverse β (fΒ―β©Cβπ
β) f"
by (elim is_inverseE, intro is_inverseI)
(
cs_concl
cs_simp: cat_sub_bw_cs_simps[symmetric]
cs_intro: cat_sub_fw_cs_intros cat_cs_intros
)
qed
lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_is_arr_isomorphismD
lemma (in subcategory) subcat_the_inverse_simp[cat_sub_bw_cs_simps]:
assumes "f : a β¦β©iβ©sβ©oβπ
β b"
shows "fΒ―β©Cβπ
β = fΒ―β©Cβββ"
proof-
from assms have "is_inverse π
(fΒ―β©Cβπ
β) f"
by (auto dest: sdg.cat_the_inverse_is_inverse)
with subcategory_axioms have inv_fπ
: "is_inverse β (fΒ―β©Cβπ
β) f"
by (auto dest: cat_sub_fw_cs_intros)
from assms have "f : a β¦β©iβ©sβ©oβββ b" by (auto dest: cat_sub_fw_cs_intros)
then have inv_fβ: "is_inverse β (fΒ―β©Cβββ) f"
by (auto dest: dg.cat_the_inverse_is_inverse)
from inv_fπ
inv_fβ show ?thesis by (intro dg.cat_is_inverse_eq)
qed
lemmas [cat_sub_bw_cs_simps] = subcategory.subcat_the_inverse_simp
lemma (in subcategory) subcat_obj_isoD:
assumes "a ββ©oβ©bβ©jβπ
β b"
shows "a ββ©oβ©bβ©jβββ b"
using assms subcategory_axioms
by (elim obj_isoE)
(
cs_concl
cs_simp: cat_sub_bw_cs_simps cs_intro: obj_isoI cat_sub_fw_cs_intros
)
lemmas [cat_sub_fw_cs_intros] = subcategory.subcat_obj_isoD
subsubsectionβΉSubcategory relation is a partial orderβΊ
lemma subcat_refl:
assumes "category Ξ± π"
shows "π ββ©CβΞ±β π"
proof-
interpret category Ξ± π by (rule assms)
show ?thesis
by (auto intro: cat_cs_intros slicing_intros subdg_refl subsemicategoryI)
qed
lemma subcat_trans:
assumes "π ββ©CβΞ±β π
" and "π
ββ©CβΞ±β β"
shows "π ββ©CβΞ±β β"
proof-
interpret ππ
: subcategory Ξ± π π
by (rule assms(1))
interpret π
β: subcategory Ξ± π
β by (rule assms(2))
show ?thesis
proof(rule subcategoryI)
show "cat_smc π ββ©Sβ©Mβ©CβΞ±β cat_smc β"
by
(
meson
ππ
.subcat_subsemicategory
π
β.subcat_subsemicategory
subsmc_trans
)
qed
(
use ππ
.subcategory_axioms π
β.subcategory_axioms in
βΉauto simp: ππ
.subcat_Obj_vsubset cat_sub_bw_cs_simpsβΊ
)
qed
lemma subcat_antisym:
assumes "π ββ©CβΞ±β π
" and "π
ββ©CβΞ±β π"
shows "π = π
"
proof-
interpret ππ
: subcategory Ξ± π π
by (rule assms(1))
interpret π
π: subcategory Ξ± π
π by (rule assms(2))
show ?thesis
proof(rule cat_eqI)
from
subsmc_antisym[
OF ππ
.subcat_subsemicategory π
π.subcat_subsemicategory
]
have
"cat_smc πβ¦Objβ¦ = cat_smc π
β¦Objβ¦" "cat_smc πβ¦Arrβ¦ = cat_smc π
β¦Arrβ¦"
by simp_all
then show Obj: "πβ¦Objβ¦ = π
β¦Objβ¦" and Arr: "πβ¦Arrβ¦ = π
β¦Arrβ¦"
unfolding slicing_simps by simp_all
show "πβ¦Domβ¦ = π
β¦Domβ¦"
by (rule vsv_eqI) (auto simp: ππ
.subcat_dom_simp Arr cat_cs_simps)
show "πβ¦Codβ¦ = π
β¦Codβ¦"
by (rule vsv_eqI) (auto simp: π
π.subcat_cod_simp Arr cat_cs_simps)
have "cat_smc π ββ©Sβ©Mβ©CβΞ±β cat_smc π
" "cat_smc π
ββ©Sβ©Mβ©CβΞ±β cat_smc π"
by (simp_all add: ππ
.subcat_subsemicategory π
π.subcat_subsemicategory)
from subsmc_antisym[OF this] have "cat_smc π = cat_smc π
" .
then have "cat_smc πβ¦Compβ¦ = cat_smc π
β¦Compβ¦" by auto
then show "πβ¦Compβ¦ = π
β¦Compβ¦" unfolding slicing_simps by simp
show "πβ¦CIdβ¦ = π
β¦CIdβ¦"
by (rule vsv_eqI) (auto simp: Obj ππ
.subcat_CId_simp cat_cs_simps)
qed (auto intro: cat_cs_intros)
qed
subsectionβΉInclusion functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.βΊ
abbreviation (input) cf_inc :: "V β V β V"
where "cf_inc β‘ dghm_inc"
textβΉSlicing.βΊ
lemma dghm_smcf_inc[slicing_commute]:
"dghm_inc (cat_smc π
) (cat_smc β) = cf_smcf (cf_inc π
β)"
unfolding cf_smcf_def dghm_inc_def cat_smc_def dg_field_simps dghm_field_simps
by (simp_all add: nat_omega_simps)
textβΉElementary properties.βΊ
lemmas [cat_cs_simps] =
dghm_inc_ObjMap_app
dghm_inc_ArrMap_app
subsubsectionβΉCanonical inclusion functor associated with a subcategoryβΊ
sublocale subcategory β inc: is_ft_functor Ξ± π
β βΉcf_inc π
ββΊ
proof(rule is_ft_functorI)
interpret subsmc: subsemicategory Ξ± βΉcat_smc π
βΊ βΉcat_smc ββΊ
by (rule subcat_subsemicategory)
show "cf_inc π
β : π
β¦β¦β©CβΞ±β β"
proof(rule is_functorI)
show "vfsequence (cf_inc π
β)" unfolding dghm_inc_def by auto
show "vcard (cf_inc π
β) = 4β©β"
unfolding dghm_inc_def by (simp add: nat_omega_simps)
from sdg.cat_CId_is_arr subcat_CId_simp show "c ββ©β π
β¦Objβ¦ βΉ
cf_inc π
ββ¦ArrMapβ¦β¦π
β¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦cf_inc π
ββ¦ObjMapβ¦β¦cβ¦β¦"
for c
unfolding dghm_inc_components by force
from subsmc.inc.is_ft_semifunctor_axioms show
"cf_smcf (cf_inc π
β) : cat_smc π
β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc β"
unfolding slicing_commute by auto
qed (auto simp: dghm_inc_components cat_cs_intros)
from subsmc.inc.is_ft_semifunctor_axioms show
"cf_smcf (cf_inc π
β) : cat_smc π
β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β cat_smc β"
unfolding slicing_commute by auto
qed
lemmas (in subcategory) subcat_cf_inc_is_ft_functor = inc.is_ft_functor_axioms
subsubsectionβΉInclusion functor for the opposite categoriesβΊ
lemma (in subcategory) subcat_cf_inc_op_cat_is_functor:
"cf_inc (op_cat π
) (op_cat β) : op_cat π
β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β op_cat β"
by
(
intro
subcategory.subcat_cf_inc_is_ft_functor
subcat_subcategory_op_cat
)
lemma (in subcategory) subcat_op_cat_cf_inc:
"cf_inc (op_cat π
) (op_cat β) = op_cf (cf_inc π
β)"
by (rule cf_eqI)
(
auto
simp:
cat_op_simps
dghm_inc_components
subcat_cf_inc_op_cat_is_functor
is_ft_functor.axioms(1)
intro: cat_op_intros
)
subsectionβΉFull subcategoryβΊ
textβΉSee Chapter I-3 in \cite{mac_lane_categories_2010}.βΊ
locale fl_subcategory = subcategory +
assumes fl_subcat_fl_subsemicategory: "cat_smc π
ββ©Sβ©Mβ©Cβ©.β©fβ©uβ©lβ©lβΞ±β cat_smc β"
abbreviation is_fl_subcategory ("(_/ ββ©Cβ©.β©fβ©uβ©lβ©lΔ± _)" [51, 51] 50)
where "π
ββ©Cβ©.β©fβ©uβ©lβ©lβΞ±β β β‘ fl_subcategory Ξ± π
β"
textβΉRules.βΊ
mk_ide rf fl_subcategory_def[unfolded fl_subcategory_axioms_def]
|intro fl_subcategoryI|
|dest fl_subcategoryD[dest]|
|elim fl_subcategoryE[elim!]|
lemmas [cat_sub_cs_intros] = fl_subcategoryD(1)
textβΉElementary properties.βΊ
sublocale fl_subcategory β inc: is_fl_functor Ξ± π
β βΉcf_inc π
ββΊ
proof(rule is_fl_functorI)
interpret fl_subsemicategory Ξ± βΉcat_smc π
βΊ βΉcat_smc ββΊ
by (rule fl_subcat_fl_subsemicategory)
from inc.is_fl_semifunctor_axioms show
"cf_smcf (dghm_inc π
β) : cat_smc π
β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©uβ©lβ©lβΞ±β cat_smc β"
unfolding slicing_commute by simp
qed (rule inc.is_functor_axioms)
subsectionβΉWide subcategoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/wide+subcategory}
}.
βΊ
locale wide_subcategory = subcategory +
assumes wide_subcat_wide_subsemicategory: "cat_smc π
ββ©Sβ©Mβ©Cβ©.β©wβ©iβ©dβ©eβΞ±β cat_smc β"
abbreviation is_wide_subcategory ("(_/ ββ©Cβ©.β©wβ©iβ©dβ©eΔ± _)" [51, 51] 50)
where "π
ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β β β‘ wide_subcategory Ξ± π
β"
textβΉRules.βΊ
mk_ide rf wide_subcategory_def[unfolded wide_subcategory_axioms_def]
|intro wide_subcategoryI|
|dest wide_subcategoryD[dest]|
|elim wide_subcategoryE[elim!]|
lemmas [cat_sub_cs_intros] = wide_subcategoryD(1)
textβΉWide subcategory is wide subsemicategory.βΊ
context wide_subcategory
begin
interpretation wide_subsmc: wide_subsemicategory Ξ± βΉcat_smc π
βΊ βΉcat_smc ββΊ
by (rule wide_subcat_wide_subsemicategory)
lemmas_with [unfolded slicing_simps]:
wide_subcat_Obj[dg_sub_bw_cs_intros] = wide_subsmc.wide_subsmc_Obj
and wide_subcat_obj_eq[dg_sub_bw_cs_simps] = wide_subsmc.wide_subsmc_obj_eq
end
lemmas [cat_sub_bw_cs_simps] = wide_subcategory.wide_subcat_obj_eq[symmetric]
lemmas [cat_sub_bw_cs_simps] = wide_subsemicategory.wide_subsmc_obj_eq
subsubsectionβΉThe wide subcategory relation is a partial orderβΊ
lemma wide_subcat_refl:
assumes "category Ξ± π"
shows "π ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β π"
proof-
interpret category Ξ± π by (rule assms)
show ?thesis
by
(
auto intro:
assms
slicing_intros
wide_subsmc_refl
wide_subcategoryI
subsmc_refl
)
qed
lemma wide_subcat_trans[trans]:
assumes "π ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β π
" and "π
ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β β"
shows "π ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β β"
proof-
interpret ππ
: wide_subcategory Ξ± π π
by (rule assms(1))
interpret π
β: wide_subcategory Ξ± π
β by (rule assms(2))
show ?thesis
by
(
intro
wide_subcategoryI
subcat_trans[OF ππ
.subcategory_axioms π
β.subcategory_axioms],
rule wide_subsmc_trans,
rule ππ
.wide_subcat_wide_subsemicategory,
rule π
β.wide_subcat_wide_subsemicategory
)
qed
lemma wide_subcat_antisym:
assumes "π ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β π
" and "π
ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β π"
shows "π = π
"
proof-
interpret ππ
: wide_subcategory Ξ± π π
by (rule assms(1))
interpret π
π: wide_subcategory Ξ± π
π by (rule assms(2))
show ?thesis
by (rule subcat_antisym[OF ππ
.subcategory_axioms π
π.subcategory_axioms])
qed
subsectionβΉReplete subcategoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See nLab
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/replete+subcategory}
}.
βΊ
locale replete_subcategory = subcategory Ξ± π
β for Ξ± π
β +
assumes rep_subcat_is_arr_isomorphism_is_arr:
"a ββ©β π
β¦Objβ¦ βΉ f : a β¦β©iβ©sβ©oβββ b βΉ f : a β¦βπ
β b"
abbreviation is_replete_subcategory ("(_/ ββ©Cβ©.β©rβ©eβ©pΔ± _)" [51, 51] 50)
where "π
ββ©Cβ©.β©rβ©eβ©pβΞ±β β β‘ replete_subcategory Ξ± π
β"
textβΉRules.βΊ
mk_ide rf replete_subcategory_def[unfolded replete_subcategory_axioms_def]
|intro replete_subcategoryI|
|dest replete_subcategoryD[dest]|
|elim replete_subcategoryE[elim!]|
lemmas [cat_sub_cs_intros] = replete_subcategoryD(1)
textβΉElementary properties.βΊ
lemma (in replete_subcategory)
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left:
assumes "a ββ©β π
β¦Objβ¦" and "f : a β¦β©iβ©sβ©oβββ b"
shows "f : a β¦β©iβ©sβ©oβπ
β b"
proof(intro is_arr_isomorphismI is_inverseI)
from assms show f: "f : a β¦βπ
β b"
by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
have "fΒ―β©Cβββ : b β¦β©iβ©sβ©oβββ a"
by (rule dg.cat_the_inverse_is_arr_isomorphism[OF assms(2)])
with f show inv_f: "fΒ―β©Cβββ : b β¦βπ
β a"
by (auto intro: rep_subcat_is_arr_isomorphism_is_arr)
show "f : a β¦βπ
β b" by (rule f)
from dg.category_axioms assms have [cat_sub_bw_cs_simps]:
"fΒ―β©Cβββ ββ©Aβββ f = ββ¦CIdβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from dg.category_axioms assms have [cat_sub_bw_cs_simps]:
"f ββ©Aβββ fΒ―β©Cβββ = ββ¦CIdβ¦β¦bβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from subcategory_axioms f inv_f show "fΒ―β©Cβββ ββ©Aβπ
β f = π
β¦CIdβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
from subcategory_axioms f inv_f show "f ββ©Aβπ
β fΒ―β©Cβββ = π
β¦CIdβ¦β¦bβ¦"
by (cs_concl cs_simp: cat_sub_bw_cs_simps cs_intro: cat_cs_intros)
qed
lemma (in replete_subcategory)
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right:
assumes "b ββ©β π
β¦Objβ¦" and "f : a β¦β©iβ©sβ©oβββ b"
shows "f : a β¦β©iβ©sβ©oβπ
β b"
proof-
from assms(2) have "fΒ―β©Cβββ : b β¦β©iβ©sβ©oβββ a"
by (rule dg.cat_the_inverse_is_arr_isomorphism)
with assms(1) have inv_f: "fΒ―β©Cβββ : b β¦β©iβ©sβ©oβπ
β a"
by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left)
then have "(fΒ―β©Cβββ)Β―β©Cβπ
β : a β¦β©iβ©sβ©oβπ
β b"
by (rule sdg.cat_the_inverse_is_arr_isomorphism)
moreover from replete_subcategory_axioms assms inv_f have "(fΒ―β©Cβββ)Β―β©Cβπ
β = f"
by
(
cs_concl
cs_simp: cat_sub_bw_cs_simps cat_cs_simps cs_intro: cat_cs_intros
)
ultimately show ?thesis by simp
qed
lemma (in replete_subcategory)
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left_iff:
assumes "a ββ©β π
β¦Objβ¦"
shows "f : a β¦β©iβ©sβ©oβπ
β b β· f : a β¦β©iβ©sβ©oβββ b"
using assms replete_subcategory_axioms
by (intro iffI)
(
cs_concl cs_intro:
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left
cat_sub_fw_cs_intros
)
lemma (in replete_subcategory)
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right_iff:
assumes "b ββ©β π
β¦Objβ¦"
shows "f : a β¦β©iβ©sβ©oβπ
β b β· f : a β¦β©iβ©sβ©oβββ b"
using assms replete_subcategory_axioms
by (intro iffI)
(
cs_concl cs_intro:
rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right
cat_sub_fw_cs_intros
)
subsubsectionβΉThe replete subcategory relation is a partial orderβΊ
lemma rep_subcat_refl:
assumes "category Ξ± π"
shows "π ββ©Cβ©.β©rβ©eβ©pβΞ±β π"
proof-
interpret category Ξ± π by (rule assms)
show ?thesis
by (intro replete_subcategoryI subcat_refl assms is_arr_isomorphismD(1))
qed
lemma rep_subcat_trans[trans]:
assumes "π ββ©Cβ©.β©rβ©eβ©pβΞ±β π
" and "π
ββ©Cβ©.β©rβ©eβ©pβΞ±β β"
shows "π ββ©Cβ©.β©rβ©eβ©pβΞ±β β"
proof-
interpret ππ
: replete_subcategory Ξ± π π
by (rule assms(1))
interpret π
β: replete_subcategory Ξ± π
β by (rule assms(2))
show ?thesis
proof
(
intro
replete_subcategoryI
subcat_trans[OF ππ
.subcategory_axioms π
β.subcategory_axioms]
)
fix a b f assume prems: "a ββ©β πβ¦Objβ¦" "f : a β¦β©iβ©sβ©oβββ b"
have "b ββ©β π
β¦Objβ¦"
by
(
rule ππ
.dg.cat_is_arrD(3)
[
OF π
β.rep_subcat_is_arr_isomorphism_is_arr[
OF ππ
.subcat_objD[OF prems(1)] prems(2)
]
]
)
then have "f : a β¦β©iβ©sβ©oβπ
β b"
by
(
rule π
β.rep_subcat_is_arr_isomorphism_is_arr_isomorphism_right[
OF _ prems(2)
]
)
then show "f : a β¦βπβ b"
by (rule ππ
.rep_subcat_is_arr_isomorphism_is_arr[OF prems(1)])
qed
qed
lemma rep_subcat_antisym:
assumes "π ββ©Cβ©.β©rβ©eβ©pβΞ±β π
" and "π
ββ©Cβ©.β©rβ©eβ©pβΞ±β π"
shows "π = π
"
proof-
interpret ππ
: replete_subcategory Ξ± π π
by (rule assms(1))
interpret π
π: replete_subcategory Ξ± π
π by (rule assms(2))
show ?thesis
by (rule subcat_antisym[OF ππ
.subcategory_axioms π
π.subcategory_axioms])
qed
subsectionβΉWide replete subcategoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale wide_replete_subcategory =
wide_subcategory Ξ± π
β + replete_subcategory Ξ± π
β for Ξ± π
β
abbreviation is_wide_replete_subcategory ("(_/ ββ©Cβ©.β©wβ©rΔ± _)" [51, 51] 50)
where "π
ββ©Cβ©.β©wβ©rβΞ±β β β‘ wide_replete_subcategory Ξ± π
β"
textβΉRules.βΊ
mk_ide rf wide_replete_subcategory_def
|intro wide_replete_subcategoryI|
|dest wide_replete_subcategoryD[dest]|
|elim wide_replete_subcategoryE[elim!]|
lemmas [cat_sub_cs_intros] = wide_replete_subcategoryD
textβΉWide replete subcategory preserves isomorphisms.βΊ
lemma (in wide_replete_subcategory)
wr_subcat_is_arr_isomorphism_is_arr_isomorphism:
"f : a β¦β©iβ©sβ©oβπ
β b β· f : a β¦β©iβ©sβ©oβββ b"
proof(rule iffI)
assume prems: "f : a β¦β©iβ©sβ©oβββ b"
then have "a ββ©β ββ¦Objβ¦" by auto
then have a: "a ββ©β π
β¦Objβ¦" by (simp add: wide_subcat_obj_eq)
show "f : a β¦β©iβ©sβ©oβπ
β b"
by (intro rep_subcat_is_arr_isomorphism_is_arr_isomorphism_left[OF a prems])
qed
(
use wide_replete_subcategory_axioms in
βΉcs_concl cs_intro: cat_sub_fw_cs_intros βΊ
)
lemmas [cat_sub_bw_cs_simps] =
wide_replete_subcategory.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
subsubsectionβΉThe wide replete subcategory relation is a partial orderβΊ
lemma wr_subcat_refl:
assumes "category Ξ± π"
shows "π ββ©Cβ©.β©wβ©rβΞ±β π"
by (intro wide_replete_subcategoryI wide_subcat_refl rep_subcat_refl assms)
lemma wr_subcat_trans[trans]:
assumes "π ββ©Cβ©.β©wβ©rβΞ±β π
" and "π
ββ©Cβ©.β©wβ©rβΞ±β β"
shows "π ββ©Cβ©.β©wβ©rβΞ±β β"
proof-
interpret ππ
: wide_replete_subcategory Ξ± π π
by (rule assms(1))
interpret π
β: wide_replete_subcategory Ξ± π
β by (rule assms(2))
show ?thesis
by
(
intro wide_replete_subcategoryI,
rule wide_subcat_trans,
rule ππ
.wide_subcategory_axioms,
rule π
β.wide_subcategory_axioms,
rule rep_subcat_trans,
rule ππ
.replete_subcategory_axioms,
rule π
β.replete_subcategory_axioms
)
qed
lemma wr_subcat_antisym:
assumes "π ββ©Cβ©.β©wβ©rβΞ±β π
" and "π
ββ©Cβ©.β©wβ©rβΞ±β π"
shows "π = π
"
proof-
interpret ππ
: wide_replete_subcategory Ξ± π π
by (rule assms(1))
interpret π
π: wide_replete_subcategory Ξ± π
π by (rule assms(2))
show ?thesis
by (rule subcat_antisym[OF ππ
.subcategory_axioms π
π.subcategory_axioms])
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Simple
sectionβΉSimple categoriesβΊ
theory CZH_ECAT_Simple
imports
CZH_Foundations.CZH_SMC_Simple
CZH_ECAT_Functor
CZH_ECAT_Small_Functor
begin
subsectionβΉBackgroundβΊ
textβΉ
The section presents a variety of simple categories,
(such as the empty category βΉ0βΊ and the singleton category βΉ1βΊ)
and functors between them (see \cite{mac_lane_categories_2010}
for further information).
βΊ
subsectionβΉEmpty category βΉ0βΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
definition cat_0 :: "V"
where "cat_0 = [0, 0, 0, 0, 0, 0]β©β"
textβΉComponents.βΊ
lemma cat_0_components:
shows "cat_0β¦Objβ¦ = 0"
and "cat_0β¦Arrβ¦ = 0"
and "cat_0β¦Domβ¦ = 0"
and "cat_0β¦Codβ¦ = 0"
and "cat_0β¦Compβ¦ = 0"
and "cat_0β¦CIdβ¦ = 0"
unfolding cat_0_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smc_cat_0: "cat_smc cat_0 = smc_0"
unfolding cat_smc_def cat_0_def smc_0_def dg_field_simps
by (simp add: nat_omega_simps)
lemmas_with (in π΅) [folded smc_cat_0, unfolded slicing_simps]:
cat_0_is_arr_iff = smc_0_is_arr_iff
subsubsectionβΉβΉ0βΊ is a categoryβΊ
lemma (in π΅) category_cat_0: "category Ξ± cat_0"
proof(intro categoryI)
show "vfsequence cat_0" "vcard cat_0 = 6β©β"
by (simp_all add: cat_0_def nat_omega_simps)
qed
(
auto simp:
cat_0_components π΅_axioms cat_0_is_arr_iff smc_cat_0 π΅.semicategory_smc_0
)
subsectionβΉEmpty functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_0 :: "V β V"
where "cf_0 π = [0, 0, cat_0, π]β©β"
textβΉComponents.βΊ
lemma cf_0_components:
shows "cf_0 πβ¦ObjMapβ¦ = 0"
and "cf_0 πβ¦ArrMapβ¦ = 0"
and "cf_0 πβ¦HomDomβ¦ = cat_0"
and "cf_0 πβ¦HomCodβ¦ = π"
unfolding cf_0_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cf_smcf_cf_0: "cf_smcf (cf_0 π) = smcf_0 (cat_smc π)"
unfolding
dg_field_simps dghm_field_simps
cf_smcf_def cf_0_def smc_0_def cat_0_def smcf_0_def cat_smc_def
by (simp add: nat_omega_simps)
subsubsectionβΉEmpty functor is a faithful functorβΊ
lemma (in π΅) cf_0_is_functor:
assumes "category Ξ± π"
shows "cf_0 π : cat_0 β¦β¦β©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β π"
proof(rule is_ft_functorI)
show "cf_0 π : cat_0 β¦β¦β©CβΞ±β π"
proof(rule is_functorI, unfold smc_cat_0 cf_smcf_cf_0)
show "vfsequence (cf_0 π)" unfolding cf_0_def by simp
show "vcard (cf_0 π) = 4β©β"
unfolding cf_0_def by (simp add: nat_omega_simps)
from π΅.smcf_0_is_semifunctor assms show
"smcf_0 (cat_smc π) : smc_0 β¦β¦β©Sβ©Mβ©CβΞ±β cat_smc π"
by auto
qed (auto simp: assms category_cat_0 cat_0_components cf_0_components)
show "cf_smcf (cf_0 π) : cat_smc cat_0 β¦β¦β©Sβ©Mβ©Cβ©.β©fβ©aβ©iβ©tβ©hβ©fβ©uβ©lβΞ±β cat_smc π"
by
(
auto simp:
assms
π΅_axioms
π΅.smcf_0_is_semifunctor
category.cat_semicategory
cf_smcf_cf_0
smc_cat_0
)
qed
subsectionβΉβΉ1βΊ: category with one object and one arrowβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
definition cat_1 :: "V β V β V"
where "cat_1 π π£ =
[
set {π},
set {π£},
set {β¨π£, πβ©},
set {β¨π£, πβ©},
set {β¨[π£, π£]β©β, π£β©},
set {β¨π, π£β©}
]β©β"
textβΉComponents.βΊ
lemma cat_1_components:
shows "cat_1 π π£β¦Objβ¦ = set {π}"
and "cat_1 π π£β¦Arrβ¦ = set {π£}"
and "cat_1 π π£β¦Domβ¦ = set {β¨π£, πβ©}"
and "cat_1 π π£β¦Codβ¦ = set {β¨π£, πβ©}"
and "cat_1 π π£β¦Compβ¦ = set {β¨[π£, π£]β©β, π£β©}"
and "cat_1 π π£β¦CIdβ¦ = set {β¨π, π£β©}"
unfolding cat_1_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smc_cat_1: "cat_smc (cat_1 π π£) = smc_1 π π£"
unfolding cat_smc_def cat_1_def smc_1_def dg_field_simps
by (simp add: nat_omega_simps)
lemmas_with (in π΅) [folded smc_cat_1, unfolded slicing_simps]:
cat_1_is_arrI = smc_1_is_arrI
and cat_1_is_arrD = smc_1_is_arrD
and cat_1_is_arrE = smc_1_is_arrE
and cat_1_is_arr_iff = smc_1_is_arr_iff
and cat_1_Comp_app[cat_cs_simps] = smc_1_Comp_app
subsubsectionβΉObjectβΊ
lemma cat_1_ObjI[cat_cs_intros]:
assumes "a = π"
shows "a ββ©β cat_1 π π£ β¦Objβ¦"
unfolding cat_1_components(1) assms by simp
subsubsectionβΉIdentityβΊ
lemma cat_1_CId_app: "cat_1 π π£β¦CIdβ¦β¦πβ¦ = π£"
unfolding cat_1_components by simp
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma cat_1_is_arrI:
assumes "f = π£" and "a = π" and "b = π"
shows "f : a β¦βcat_1 π π£β b"
by (rule is_arrI, unfold assms cat_1_components) auto
subsubsectionβΉβΉ1βΊ is a categoryβΊ
lemma (in π΅) category_cat_1:
assumes "π ββ©β Vset Ξ±" and "π£ ββ©β Vset Ξ±"
shows "category Ξ± (cat_1 π π£)"
proof(intro categoryI, unfold smc_cat_1)
show "vfsequence (cat_1 π π£)"
unfolding cat_1_def by (simp add: nat_omega_simps)
show "vcard (cat_1 π π£) = 6β©β"
unfolding cat_1_def by (simp add: nat_omega_simps)
qed (auto simp: assms semicategory_smc_1 cat_1_is_arr_iff cat_1_components)
lemmas [cat_cs_intros] = π΅.category_cat_1
lemma (in π΅) finite_category_cat_1:
assumes "π ββ©β Vset Ξ±" and "π£ ββ©β Vset Ξ±"
shows "finite_category Ξ± (cat_1 π π£)"
by (intro finite_categoryI')
(auto simp: cat_1_components intro: category_cat_1[OF assms])
lemmas [cat_small_cs_intros] = π΅.finite_category_cat_1
subsubsectionβΉOpposite of the category βΉ1βΊβΊ
lemma (in π΅) cat_1_op[cat_op_simps]:
assumes "π ββ©β Vset Ξ±" and "π£ ββ©β Vset Ξ±"
shows "op_cat (cat_1 π π£) = cat_1 π π£"
proof(rule cat_eqI, unfold cat_op_simps)
from assms show "category Ξ± (op_cat (cat_1 π π£))"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
from assms show "category Ξ± (cat_1 π π£)"
by (cs_concl cs_intro: cat_cs_intros)
show "op_cat (cat_1 π π£)β¦Compβ¦ = cat_1 π π£β¦Compβ¦"
unfolding cat_1_components op_cat_components fflip_vsingleton ..
qed (simp_all add: cat_1_components)
subsubsectionβΉFurther propertiesβΊ
lemma cf_const_if_HomCod_is_cat_1:
assumes "π : π
β¦β¦β©CβΞ±β cat_1 π π£"
shows "π = cf_const π
(cat_1 π π£) π"
proof(rule cf_eqI)
interpret π: is_functor Ξ± π
βΉcat_1 π π£βΊ π by (rule assms(1))
show "cf_const π
(cat_1 π π£) π : π
β¦β¦β©CβΞ±β cat_1 π π£"
by (cs_concl cs_intro: cat_cs_intros)
have ObjMap_dom_lhs: "πβ©β (πβ¦ObjMapβ¦) = π
β¦Objβ¦" by (simp add: cat_cs_simps)
have ObjMap_dom_rhs: "πβ©β (cf_const π
(cat_1 π π£) πβ¦ObjMapβ¦) = π
β¦Objβ¦"
by (simp add: cat_cs_simps)
have ArrMap_dom_lhs: "πβ©β (πβ¦ArrMapβ¦) = π
β¦Arrβ¦" by (simp add: cat_cs_simps)
have ArrMap_dom_rhs: "πβ©β (cf_const π
(cat_1 π π£) πβ¦ArrMapβ¦) = π
β¦Arrβ¦"
by (simp add: cat_cs_simps)
show "πβ¦ObjMapβ¦ = cf_const π
(cat_1 π π£) πβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume prems: "a ββ©β π
β¦Objβ¦"
then have "πβ¦ObjMapβ¦β¦aβ¦ ββ©β cat_1 π π£β¦Objβ¦"
by (auto intro: π.cf_ObjMap_app_in_HomCod_Obj)
then have "πβ¦ObjMapβ¦β¦aβ¦ = π" by (auto simp: cat_1_components)
with prems show "πβ¦ObjMapβ¦β¦aβ¦ = cf_const π
(cat_1 π π£) πβ¦ObjMapβ¦β¦aβ¦"
by (auto simp: cat_cs_simps)
qed (auto intro: cat_cs_intros)
show "πβ¦ArrMapβ¦ = cf_const π
(cat_1 π π£) πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix a assume prems: "a ββ©β π
β¦Arrβ¦"
then have "πβ¦ArrMapβ¦β¦aβ¦ ββ©β cat_1 π π£β¦Arrβ¦"
by (auto intro: π.cf_ArrMap_app_in_HomCod_Arr)
then have "πβ¦ArrMapβ¦β¦aβ¦ = π£" by (auto simp: cat_1_components)
with prems show "πβ¦ArrMapβ¦β¦aβ¦ = cf_const π
(cat_1 π π£) πβ¦ArrMapβ¦β¦aβ¦"
by (auto simp: cat_1_CId_app cat_cs_simps)
qed (auto intro: cat_cs_intros)
qed (simp_all add: assms)
lemma cf_const_if_HomDom_is_cat_1:
assumes "π : cat_1 π π£ β¦β¦β©CβΞ±β β"
shows "π = cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)"
proof-
interpret π: is_functor Ξ± βΉcat_1 π π£βΊ β π by (rule assms(1))
from cat_1_components(1) have π: "π ββ©β Vset Ξ±"
by (auto simp: π.HomDom.cat_in_Obj_in_Vset)
from cat_1_components(2) have π£: "π£ ββ©β Vset Ξ±"
by (auto simp: π.HomDom.cat_in_Arr_in_Vset)
from π π£ interpret cf_1:
is_tm_functor Ξ± βΉcat_1 π π£βΊ β βΉcf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)βΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
show ?thesis
proof(rule cf_eqI)
show "cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦) : cat_1 π π£ β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
have ObjMap_dom_lhs: "πβ©β (πβ¦ObjMapβ¦) = set {π}"
by (simp add: cat_cs_simps cat_1_components)
have ObjMap_dom_rhs:
"πβ©β (cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦) = set {π}"
by (simp add: cat_cs_simps cat_1_components)
show "πβ¦ObjMapβ¦ = cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume "a ββ©β set {π}"
then have a_def: "a = π" by simp
show "πβ¦ObjMapβ¦β¦aβ¦ = cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_1_components(1) cat_cs_simps a_def
cs_intro: V_cs_intros
)
qed auto
have ArrMap_dom_lhs: "πβ©β (πβ¦ArrMapβ¦) = set {π£}"
by (simp add: cat_cs_simps cat_1_components)
have ArrMap_dom_rhs:
"πβ©β (cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦) = set {π£}"
by (simp add: cat_cs_simps cat_1_components)
show "πβ¦ArrMapβ¦ = cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume "f ββ©β set {π£}"
then have f_def: "f = π£" by simp
show "πβ¦ArrMapβ¦β¦fβ¦ = cf_const (cat_1 π π£) β (πβ¦ObjMapβ¦β¦πβ¦)β¦ArrMapβ¦β¦fβ¦"
unfolding f_def
by (subst cat_1_CId_app[symmetric, of π£ π])
(
cs_concl
cs_simp: cat_1_components(1,2) cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros
)
qed auto
qed (simp_all add: assms)
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Discrete
sectionβΉDiscrete categoryβΊ
theory CZH_ECAT_Discrete
imports
CZH_ECAT_Simple
CZH_ECAT_Small_Functor
begin
subsectionβΉAbstract discrete categoryβΊ
named_theorems cat_discrete_cs_simps
named_theorems cat_discrete_cs_intros
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
locale cat_discrete = category Ξ± β for Ξ± β +
assumes cat_discrete_Arr: "f ββ©β ββ¦Arrβ¦ βΉ f ββ©β ββ©β (ββ¦CIdβ¦)"
textβΉRules.βΊ
lemma (in cat_discrete)
assumes "Ξ±' = Ξ±" "β' = β"
shows "cat_discrete Ξ±' β'"
unfolding assms by (rule cat_discrete_axioms)
mk_ide rf cat_discrete_def[unfolded cat_discrete_axioms_def]
|intro cat_discreteI|
|dest cat_discreteD[dest]|
|elim cat_discreteE[elim]|
lemmas [cat_discrete_cs_intros] = cat_discreteD(1)
textβΉElementary properties.βΊ
lemma (in cat_discrete) cat_discrete_is_arrD[dest]:
assumes "f : a β¦βββ b"
shows "b = a" and "f = ββ¦CIdβ¦β¦aβ¦"
proof-
from assms cat_discrete_Arr have "f ββ©β ββ©β (ββ¦CIdβ¦)"
by (auto simp: cat_cs_simps)
with cat_CId_vdomain obtain a' where f_def: "f = ββ¦CIdβ¦β¦a'β¦" and "a' ββ©β ββ¦Objβ¦"
by (blast dest: CId.vrange_atD)
then have "f : a' β¦βββ a'" by (auto intro: cat_CId_is_arr')
with assms have "a = a'" and "b = a'" by blast+
with f_def show "b = a" and "f = ββ¦CIdβ¦β¦aβ¦" by auto
qed
lemma (in cat_discrete) cat_discrete_is_arrE[elim]:
assumes "f : b β¦βββ c"
obtains a where "f : a β¦βββ a" and "f = ββ¦CIdβ¦β¦aβ¦"
using assms by auto
subsectionβΉThe discrete categoryβΊ
textβΉ
As explained in Chapter I-2 in \cite{mac_lane_categories_2010}, every discrete
category is identified with its set of objects.
In this work, it is assumed that the set of objects and the set of arrows
in the canonical discrete category coincide; the domain and the codomain
functions are identities.
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition the_cat_discrete :: "V β V" (βΉ:β©CβΊ)
where ":β©C I = [I, I, vid_on I, vid_on I, (Ξ»fgββ©βfid_on I. fgβ¦0β¦), vid_on I]β©β"
textβΉComponents.βΊ
lemma the_cat_discrete_components:
shows ":β©C Iβ¦Objβ¦ = I"
and ":β©C Iβ¦Arrβ¦ = I"
and ":β©C Iβ¦Domβ¦ = vid_on I"
and ":β©C Iβ¦Codβ¦ = vid_on I"
and ":β©C Iβ¦Compβ¦ = (Ξ»fgββ©βfid_on I. fgβ¦0β¦)"
and ":β©C Iβ¦CIdβ¦ = vid_on I"
unfolding the_cat_discrete_def dg_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉDomainβΊ
mk_VLambda the_cat_discrete_components(3)[folded VLambda_vid_on]
|vsv the_cat_discrete_Dom_vsv[cat_discrete_cs_intros]|
|vdomain the_cat_discrete_Dom_vdomain[cat_discrete_cs_simps]|
|app the_cat_discrete_Dom_app[cat_discrete_cs_simps]|
subsubsectionβΉCodomainβΊ
mk_VLambda the_cat_discrete_components(4)[folded VLambda_vid_on]
|vsv the_cat_discrete_Cod_vsv[cat_discrete_cs_intros]|
|vdomain the_cat_discrete_Cod_vdomain[cat_discrete_cs_simps]|
|app the_cat_discrete_Cod_app[cat_discrete_cs_simps]|
subsubsectionβΉCompositionβΊ
lemma the_cat_discrete_Comp_vsv[cat_discrete_cs_intros]: "vsv (:β©C Iβ¦Compβ¦)"
unfolding the_cat_discrete_components by simp
lemma the_cat_discrete_Comp_vdomain: "πβ©β (:β©C Iβ¦Compβ¦) = fid_on I"
unfolding the_cat_discrete_components by simp
lemma the_cat_discrete_Comp_vrange:
"ββ©β (:β©C Iβ¦Compβ¦) = I"
proof(intro vsubset_antisym vsubsetI)
fix f assume "f ββ©β ββ©β (:β©C Iβ¦Compβ¦)"
then obtain gg where f_def: "f = :β©C Iβ¦Compβ¦β¦ggβ¦" and gg: "gg ββ©β fid_on I"
unfolding the_cat_discrete_components by auto
from gg show "f ββ©β I"
unfolding f_def the_cat_discrete_components by clarsimp
next
fix f assume "f ββ©β I"
then have "[f, f]β©β ββ©β fid_on I" by clarsimp
moreover then have "f = :β©C Iβ¦Compβ¦β¦f, fβ¦β©β"
unfolding the_cat_discrete_components by simp
ultimately show "f ββ©β ββ©β (:β©C Iβ¦Compβ¦)"
unfolding the_cat_discrete_components
by (metis rel_VLambda.vsv_vimageI2 vdomain_VLambda)
qed
lemma the_cat_discrete_Comp_app[cat_discrete_cs_simps]:
assumes "i ββ©β I"
shows "i ββ©Aβ:β©C Iβ i = i"
proof-
from assms have "[i, i]β©β ββ©β fid_on I" by clarsimp
then show ?thesis unfolding the_cat_discrete_components by simp
qed
subsubsectionβΉIdentityβΊ
mk_VLambda the_cat_discrete_components(6)[folded VLambda_vid_on]
|vsv the_cat_discrete_CId_vsv[cat_discrete_cs_intros]|
|vdomain the_cat_discrete_CId_vdomain[cat_discrete_cs_simps]|
|app the_cat_discrete_CId_app[cat_discrete_cs_simps]|
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma the_cat_discrete_is_arrI:
assumes "i ββ©β I"
shows "i : i β¦β:β©C Iβ i"
using assms unfolding is_arr_def the_cat_discrete_components by simp
lemma the_cat_discrete_is_arrI'[cat_discrete_cs_intros]:
assumes "i ββ©β I"
and "a = i"
and "b = i"
shows "i : a β¦β:β©C Iβ b"
using assms(1) unfolding assms(2,3) by (rule the_cat_discrete_is_arrI)
lemma the_cat_discrete_is_arrD:
assumes "f : a β¦β:β©C Iβ b"
shows "f : f β¦β:β©C Iβ f"
and "a : a β¦β:β©C Iβ a"
and "b : b β¦β:β©C Iβ b"
and "f ββ©β I"
and "a ββ©β I"
and "b ββ©β I"
and "f = a"
and "f = b"
and "b = a"
using assms unfolding is_arr_def the_cat_discrete_components by force+
subsubsectionβΉThe discrete category is a discrete categoryβΊ
lemma (in π΅) cat_discrete_the_cat_discrete:
assumes "I ββ©β Vset Ξ±"
shows "cat_discrete Ξ± (:β©C I)"
proof(intro cat_discreteI categoryI')
show "vfsequence (:β©C I)" unfolding the_cat_discrete_def by simp
show "vcard (:β©C I) = 6β©β"
unfolding the_cat_discrete_def by (simp add: nat_omega_simps)
show "gf ββ©β πβ©β (:β©C Iβ¦Compβ¦) β·
(βg f b c a. gf = [g, f]β©β β§ g : b β¦β:β©C Iβ c β§ f : a β¦β:β©C Iβ b)"
for gf
unfolding the_cat_discrete_Comp_vdomain
proof
assume "gf ββ©β fid_on I"
then obtain a where "gf = [a, a]β©β" and "a ββ©β I" by clarsimp
moreover then have "a : a β¦β:β©C Iβ a"
by (auto intro: the_cat_discrete_is_arrI)
ultimately show
"βg f b c a. gf = [g, f]β©β β§ g : b β¦β:β©C Iβ c β§ f : a β¦β:β©C Iβ b"
by auto
next
assume "βg f b c a. gf = [g, f]β©β β§ g : b β¦β:β©C Iβ c β§ f : a β¦β:β©C Iβ b"
then obtain g f b c a where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦β:β©C Iβ c"
and f: "f : a β¦β:β©C Iβ b"
by clarsimp
then have "g = f" by (metis is_arrE the_cat_discrete_is_arrD(1))
with the_cat_discrete_is_arrD(4)[OF f] show "gf ββ©β fid_on I"
unfolding gf_def by clarsimp
qed
show "g ββ©Aβ:β©C Iβ f : a β¦β:β©C Iβ c" if "g : b β¦β:β©C Iβ c" and "f : a β¦β:β©C Iβ b"
for g b c f a
proof-
from that have fba: "f = a" "b = a" and a: "a ββ©β I"
unfolding the_cat_discrete_is_arrD[OF that(2)] by (simp_all add: βΉa ββ©β IβΊ)
from that have gcb: "g = b" "c = b"
unfolding the_cat_discrete_is_arrD[OF that(1)] by simp_all
from a show ?thesis
unfolding fba gcb
by
(
cs_concl
cs_simp: cat_discrete_cs_simps cs_intro: cat_discrete_cs_intros
)
qed
show "h ββ©Aβ:β©C Iβ g ββ©Aβ:β©C Iβ f = h ββ©Aβ:β©C Iβ (g ββ©Aβ:β©C Iβ f)"
if "h : c β¦β:β©C Iβ d" and "g : b β¦β:β©C Iβ c" and "f : a β¦β:β©C Iβ b"
for h c d g b f a
proof-
from that have fba: "f = a" "b = a" and a: "a ββ©β I"
unfolding the_cat_discrete_is_arrD[OF that(3)] by (simp_all add: βΉa ββ©β IβΊ)
from that have gcb: "g = b" "c = b"
unfolding the_cat_discrete_is_arrD[OF that(2)] by simp_all
from that have hcd: "h = c" "d = c"
unfolding the_cat_discrete_is_arrD[OF that(1)] by simp_all
from a show ?thesis
unfolding fba gcb hcd by (cs_concl cs_simp: cat_discrete_cs_simps)
qed
show ":β©C Iβ¦CIdβ¦β¦bβ¦ ββ©Aβ:β©C Iβ f = f" if "f : a β¦β:β©C Iβ b" for f a b
proof-
from that have fba: "f = a" "b = a" and a: "a ββ©β I"
unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: βΉa ββ©β IβΊ)
from a show ?thesis
by (cs_concl cs_simp: cat_discrete_cs_simps fba)
qed
show "f ββ©Aβ:β©C Iβ :β©C Iβ¦CIdβ¦β¦bβ¦ = f" if "f : b β¦β:β©C Iβ c" for f b c
proof-
from that have fba: "f = b" "c = b" and b: "b ββ©β I"
unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: βΉb ββ©β IβΊ)
from b show ?thesis
by (cs_concl cs_simp: cat_discrete_cs_simps fba)
qed
show ":β©C Iβ¦CIdβ¦β¦aβ¦ : a β¦β:β©C Iβ a"
if "a ββ©β :β©C Iβ¦Objβ¦" for a
using that
by (auto simp: the_cat_discrete_components intro: cat_discrete_cs_intros)
show "ββ©β((Ξ»aββ©βA. ββ©β(VLambda B (Hom (:β©C I) a) `β©β B)) `β©β A) ββ©β Vset Ξ±"
if "A ββ©β :β©C Iβ¦Objβ¦"
and "B ββ©β :β©C Iβ¦Objβ¦"
and "A ββ©β Vset Ξ±"
and "B ββ©β Vset Ξ±"
for A B
proof-
have "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (:β©C I) a b) ββ©β A βͺβ©β B"
proof(intro vsubsetI, elim vifunionE, unfold in_Hom_iff)
fix i j f assume prems: "i ββ©β A" "j ββ©β B" "f : i β¦β:β©C Iβ j"
then show "f ββ©β A βͺβ©β B"
unfolding the_cat_discrete_is_arrD[OF prems(3)] by simp
qed
moreover have "A βͺβ©β B ββ©β Vset Ξ±" by (simp add: that(3,4) vunion_in_VsetI)
ultimately show "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (:β©C I) a b) ββ©β Vset Ξ±"
by (auto simp: vsubset_in_VsetI)
qed
qed (auto simp: assms the_cat_discrete_components intro: cat_cs_intros)
lemmas [cat_discrete_cs_intros] = π΅.cat_discrete_the_cat_discrete
subsubsectionβΉOpposite discrete categoryβΊ
lemma (in π΅) the_cat_discrete_op[cat_op_simps]:
assumes "I ββ©β Vset Ξ±"
shows "op_cat (:β©C I) = :β©C I"
proof(rule cat_eqI[of Ξ±])
from assms show dI: "category Ξ± (:β©C I)"
by (cs_concl cs_intro: cat_discrete_the_cat_discrete cat_discrete_cs_intros)
then show op_dI: "category Ξ± (op_cat (:β©C I))"
by (cs_concl cs_intro: cat_op_intros)
interpret category Ξ± βΉop_cat (:β©C I)βΊ by (rule op_dI)
show "op_cat (:β©C I)β¦Compβ¦ = :β©C Iβ¦Compβ¦"
proof(rule vsv_eqI)
show "πβ©β (op_cat (:β©C I)β¦Compβ¦) = πβ©β (:β©C Iβ¦Compβ¦)"
by (simp add: the_cat_discrete_components op_cat_components)
fix gf assume "gf ββ©β πβ©β (op_cat (:β©C I)β¦Compβ¦)"
then have "gf ββ©β fid_on I"
by (simp add: the_cat_discrete_components op_cat_components)
then obtain h where gf_def: "gf = [h, h]β©β" and h: "h ββ©β I" by clarsimp
from dI h show "op_cat (:β©C I)β¦Compβ¦β¦gfβ¦ = :β©C Iβ¦Compβ¦β¦gfβ¦"
by
(
cs_concl
cs_simp: cat_op_simps gf_def cs_intro: cat_discrete_cs_intros
)
qed (auto intro: cat_discrete_cs_intros)
qed (unfold the_cat_discrete_components op_cat_components, simp_all)
subsectionβΉDiscrete functorβΊ
subsubsectionβΉLocal assumptions for the discrete functorβΊ
textβΉSee Chapter III in \cite{mac_lane_categories_2010}).βΊ
locale cf_discrete = category Ξ± β for Ξ± I F β +
assumes cf_discrete_selector_vrange[cat_discrete_cs_intros]:
"i ββ©β I βΉ F i ββ©β ββ¦Objβ¦"
and cf_discrete_vdomain_vsubset_Vset: "I ββ©β Vset Ξ±"
lemmas (in cf_discrete) cf_discrete_category = category_axioms
lemmas [cat_discrete_cs_intros] = cf_discrete.cf_discrete_category
textβΉRules.βΊ
lemma (in cf_discrete) cf_discrete_axioms'[cat_discrete_cs_intros]:
assumes "Ξ±' = Ξ±" and "I' = I" and "F' = F"
shows "cf_discrete Ξ±' I' F' β"
unfolding assms by (rule cf_discrete_axioms)
mk_ide rf cf_discrete_def[unfolded cf_discrete_axioms_def]
|intro cf_discreteI|
|dest cf_discreteD[dest]|
|elim cf_discreteE[elim]|
textβΉElementary properties.βΊ
lemma (in cf_discrete) cf_discrete_is_functor_cf_CId_selector_is_arr:
assumes "i ββ©β I"
shows "ββ¦CIdβ¦β¦F iβ¦ : F i β¦βββ F i"
using assms by (meson cat_CId_is_arr' cf_discreteD(2) cf_discrete_axioms)
lemma (in cf_discrete)
cf_discrete_is_functor_cf_CId_selector_is_arr'[cat_discrete_cs_intros]:
assumes "i ββ©β I" and "a = F i" and "b = F i"
shows "ββ¦CIdβ¦β¦F iβ¦ : a β¦βββ b"
using assms(1)
unfolding assms(2,3)
by (rule cf_discrete_is_functor_cf_CId_selector_is_arr)
subsubsectionβΉDefinition and elementary propertiesβΊ
definition the_cf_discrete :: "V β (V β V) β V β V" (βΉ:β:βΊ)
where ":β: I F β = [VLambda I F, (Ξ»iββ©βI. ββ¦CIdβ¦β¦F iβ¦), :β©C I, β]β©β"
textβΉComponents.βΊ
lemma the_cf_discrete_components:
shows ":β: I F ββ¦ObjMapβ¦ = (Ξ»iββ©βI. F i)"
and ":β: I F ββ¦ArrMapβ¦ = (Ξ»iββ©βI. ββ¦CIdβ¦β¦F iβ¦)"
and [cat_discrete_cs_simps]: ":β: I F ββ¦HomDomβ¦ = :β©C I"
and [cat_discrete_cs_simps]: ":β: I F ββ¦HomCodβ¦ = β"
unfolding the_cf_discrete_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda the_cf_discrete_components(1)
|vsv the_cf_discrete_ObjMap_vsv[cat_discrete_cs_intros]|
|vdomain the_cf_discrete_ObjMap_vdomain[cat_discrete_cs_simps]|
|app the_cf_discrete_ObjMap_app[cat_discrete_cs_simps]|
lemma (in cf_discrete) cf_discrete_the_cf_discrete_ObjMap_vrange:
"ββ©β (:β: I F ββ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
using cf_discrete_is_functor_cf_CId_selector_is_arr
unfolding the_cf_discrete_components
by (intro vrange_VLambda_vsubset) auto
subsubsectionβΉArrow mapβΊ
mk_VLambda the_cf_discrete_components(2)
|vsv the_cf_discrete_ArrMap_vsv[cat_discrete_cs_intros]|
|vdomain the_cf_discrete_ArrMap_vdomain[cat_discrete_cs_simps]|
|app the_cf_discrete_ArrMap_app[cat_discrete_cs_simps]|
lemma (in cf_discrete) cf_discrete_the_cf_discrete_ArrMap_vrange:
"ββ©β (:β: I F ββ¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
using cf_discrete_is_functor_cf_CId_selector_is_arr
unfolding the_cf_discrete_components
by (intro vrange_VLambda_vsubset) (auto simp: cf_discrete_selector_vrange)
subsubsectionβΉDiscrete functor is a functorβΊ
lemma (in cf_discrete) cf_discrete_the_cf_discrete_is_functor:
":β: I F β : :β©C I β¦β¦β©CβΞ±β β"
proof(intro is_functorI')
show "vfsequence (:β: I F β)" unfolding the_cf_discrete_def by simp
show "category Ξ± (:β©C I)"
by
(
simp add:
cat_discrete_the_cat_discrete
cf_discrete_vdomain_vsubset_Vset
cat_discrete.axioms(1)
)
show "vcard (:β: I F β) = 4β©β"
unfolding the_cf_discrete_def by (simp add: nat_omega_simps)
show
":β: I F ββ¦ArrMapβ¦β¦fβ¦ : :β: I F ββ¦ObjMapβ¦β¦aβ¦ β¦βββ :β: I F ββ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦β:β©C Iβ b" for f a b
proof-
from that have fba: "f = a" "b = a" and a: "a ββ©β I"
unfolding the_cat_discrete_is_arrD[OF that] by (simp_all add: βΉa ββ©β IβΊ)
from that βΉa ββ©β IβΊ show ?thesis
by
(
cs_concl
cs_simp: cat_discrete_cs_simps fba cs_intro: cat_discrete_cs_intros
)
qed
show ":β: I F ββ¦ArrMapβ¦β¦g ββ©Aβ:β©C Iβ fβ¦ =
:β: I F ββ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ :β: I F ββ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦β:β©C Iβ c" and "f : a β¦β:β©C Iβ b" for g b c f a
proof-
from that have gfacb: "f = a" "a = b" "g = b" "c = b" and b: "b ββ©β I"
by
(
simp_all add:
the_cat_discrete_is_arrD(8-9)[OF that(1)]
the_cat_discrete_is_arrD(5-9)[OF that(2)]
)
have "F b ββ©β ββ¦Objβ¦" by (simp add: b cf_discrete_selector_vrange)
from b category_axioms this show ?thesis
using that
unfolding gfacb
by
(
cs_concl
cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
)
qed
show ":β: I F ββ¦ArrMapβ¦β¦:β©C Iβ¦CIdβ¦β¦cβ¦β¦ = ββ¦CIdβ¦β¦:β: I F ββ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β :β©C Iβ¦Objβ¦" for c
using that
unfolding the_cat_discrete_components(1)
by (cs_concl cs_simp: cat_discrete_cs_simps cs_intro: cat_cs_intros)
qed
(
auto simp:
the_cf_discrete_components
the_cat_discrete_components
cat_cs_intros
cat_discrete_cs_intros
)
lemma (in cf_discrete) cf_discrete_the_cf_discrete_is_functor':
assumes "π' = :β©C I" and "β' = β"
shows ":β: I F β : π' β¦β¦β©CβΞ±β β'"
unfolding assms by (rule cf_discrete_the_cf_discrete_is_functor)
lemmas [cat_discrete_cs_intros] =
cf_discrete.cf_discrete_the_cf_discrete_is_functor'
subsubsectionβΉUniqueness of the discrete categoryβΊ
lemma (in cat_discrete) cat_discrete_iso_the_cat_discrete:
assumes "I ββ©β Vset Ξ±" and "I ββ©β ββ¦Objβ¦"
obtains F where ":β: I F β : :β©C I β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β"
proof-
from assms obtain F where v11_f: "v11 F"
and dr[simp]: "πβ©β F = I" "ββ©β F = ββ¦Objβ¦"
by auto
let ?F = "Ξ»i. Fβ¦iβ¦"
interpret F: v11 F by (rule v11_f)
from assms(1) interpret β: cf_discrete Ξ± I ?F β
apply(intro cf_discreteI)
unfolding dr[symmetric]
by (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
have ":β: I ?F β : :β©C I β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β β"
proof(intro is_iso_functorI')
from β.cf_discrete_selector_vrange show
":β: I ?F β : :β©C I β¦β¦β©CβΞ±β β"
by (intro cf_discrete.cf_discrete_the_cf_discrete_is_functor cf_discreteI)
(auto simp: category_axioms assms(1))
show "v11 (:β: I ?F ββ¦ArrMapβ¦)"
proof(rule vsv.vsv_valeq_v11I, unfold the_cf_discrete_ArrMap_vdomain)
fix i j assume prems:
"i ββ©β I" "j ββ©β I" ":β: I ?F ββ¦ArrMapβ¦β¦iβ¦ = :β: I ?F ββ¦ArrMapβ¦β¦jβ¦"
from prems(3) have "ββ¦CIdβ¦β¦?F iβ¦ = ββ¦CIdβ¦β¦?F jβ¦"
unfolding
the_cf_discrete_ArrMap_app[OF prems(1)]
the_cf_discrete_ArrMap_app[OF prems(2)].
then have "?F i = ?F j"
by
(
metis
β.cf_discrete_is_functor_cf_CId_selector_is_arr
prems(1,2)
cat_is_arrD(4)
)
with F.v11_eq_iff prems show "i = j" by simp
qed (simp add: the_cf_discrete_components)
show "ββ©β (:β: I ?F ββ¦ArrMapβ¦) = ββ¦Arrβ¦"
proof(intro vsubset_antisym vsubsetI)
fix f assume "f ββ©β ββ©β (:β: I ?F ββ¦ArrMapβ¦)"
with β.cf_discrete_the_cf_discrete_ArrMap_vrange show "f ββ©β ββ¦Arrβ¦"
by auto
next
fix f assume "f ββ©β ββ¦Arrβ¦"
then obtain a b where "f : a β¦βββ b" by auto
then obtain a where f_def: "f = ββ¦CIdβ¦β¦aβ¦" and a: "a ββ©β ββ¦Objβ¦" by auto
from a F.vrange_atD dr obtain i where a_def: "a = ?F i" and i: "i ββ©β I"
by blast
from a i show "f ββ©β ββ©β (:β: I ?F ββ¦ArrMapβ¦)"
unfolding a_def f_def the_cf_discrete_components by auto
qed
qed (auto simp: v11_f the_cf_discrete_components)
with that show ?thesis by simp
qed
subsubsectionβΉOpposite discrete functorβΊ
lemma (in cf_discrete) cf_discrete_the_cf_discrete_op[cat_op_simps]:
"op_cf (:β: I F β) = :β: I F (op_cat β)"
proof(rule cf_eqI)
from cf_discrete_vdomain_vsubset_Vset show
"op_cf (:β: I F β) : :β©C I β¦β¦β©CβΞ±β op_cat β"
by
(
cs_concl
cs_simp: cat_op_simps cs_intro: cat_op_intros cat_discrete_cs_intros
)
show ":β: I F (op_cat β) : :β©C I β¦β¦β©CβΞ±β op_cat β"
proof(intro cf_discrete.cf_discrete_the_cf_discrete_is_functor cf_discreteI)
fix i assume "i ββ©β I"
then show "F i ββ©β op_cat ββ¦Objβ¦"
by (simp add: cat_op_simps cf_discrete_selector_vrange)
qed (intro cf_discrete_vdomain_vsubset_Vset cat_cs_intros)+
qed (unfold cat_op_simps the_cf_discrete_components, simp_all)
lemmas [cat_op_simps] = cf_discrete.cf_discrete_the_cf_discrete_op
lemma (in cf_discrete) cf_discrete_op[cat_op_intros]:
"cf_discrete Ξ± I F (op_cat β)"
proof(intro cf_discreteI)
show "category Ξ± (op_cat β)" by (cs_concl cs_intro: cat_cs_intros)
fix i assume "i ββ©β I"
then show "F i ββ©β op_cat ββ¦Objβ¦"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_discrete_cs_intros)
qed (intro cf_discrete_vdomain_vsubset_Vset)
lemmas [cat_op_intros] = cf_discrete.cf_discrete_op
subsectionβΉTiny discrete categoryβΊ
subsubsectionβΉBackgroundβΊ
named_theorems cat_small_discrete_cs_simps
named_theorems cat_small_discrete_cs_intros
lemmas [cat_small_discrete_cs_simps] = cat_discrete_cs_simps
lemmas [cat_small_discrete_cs_intros] = cat_discrete_cs_intros
subsubsectionβΉDefinition and elementary propertiesβΊ
locale tiny_cat_discrete = cat_discrete Ξ± β + tiny_category Ξ± β for Ξ± β
textβΉRules.βΊ
lemma (in tiny_cat_discrete) tiny_cat_discrete_axioms'[cat_discrete_cs_intros]:
assumes "Ξ±' = Ξ±" and "β' = β"
shows "tiny_cat_discrete Ξ±' β'"
unfolding assms by (rule tiny_cat_discrete_axioms)
mk_ide rf tiny_cat_discrete_def
|intro tiny_cat_discreteI|
|dest tiny_cat_discreteD[dest]|
|elim tiny_cat_discreteE[elim]|
lemmas [cat_small_discrete_cs_intros] = tiny_cat_discreteD
lemma tiny_cat_discreteI':
assumes "tiny_category Ξ± β" and "βf. f ββ©β ββ¦Arrβ¦ βΉ f ββ©β ββ©β (ββ¦CIdβ¦)"
shows "tiny_cat_discrete Ξ± β"
proof(intro tiny_cat_discreteI cat_discreteI)
interpret tiny_category Ξ± β by (rule assms(1))
show "category Ξ± β" by (auto intro: tiny_dg_category)
show "f ββ©β ββ©β (ββ¦CIdβ¦)" if "f ββ©β ββ¦Arrβ¦" for f using that by (rule assms(2))
qed (auto intro: assms(1))
subsubsectionβΉThe discrete category is a tiny categoryβΊ
lemma (in π΅) tiny_cat_discrete_the_cat_discrete[cat_small_discrete_cs_intros]:
assumes "I ββ©β Vset Ξ±"
shows "tiny_cat_discrete Ξ± (:β©C I)"
proof(intro tiny_cat_discreteI cat_discrete_the_cat_discrete)
from assms show "I ββ©β Vset Ξ±" by auto
then interpret cat_discrete Ξ± βΉ:β©C IβΊ by (intro cat_discrete_the_cat_discrete)
show "tiny_category Ξ± (:β©C I)"
by (intro tiny_categoryI', unfold the_cat_discrete_components)
(auto intro: cat_cs_intros assms)
qed
lemmas [cat_small_discrete_cs_intros] = π΅.cat_discrete_the_cat_discrete
subsectionβΉDiscrete functor with tiny mapsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
locale tm_cf_discrete = category Ξ± β for Ξ± I F β +
assumes tm_cf_discrete_selector_vrange[cat_small_discrete_cs_intros]:
"i ββ©β I βΉ F i ββ©β ββ¦Objβ¦"
and tm_cf_discrete_ObjMap_in_Vset: "VLambda I F ββ©β Vset Ξ±"
and tm_cf_discrete_ArrMap_in_Vset: "(Ξ»iββ©βI. ββ¦CIdβ¦β¦F iβ¦) ββ©β Vset Ξ±"
textβΉRules.βΊ
lemma (in tm_cf_discrete) tm_cf_discrete_axioms'[cat_small_discrete_cs_intros]:
assumes "Ξ±' = Ξ±" and "I' = I" and "F' = F"
shows "tm_cf_discrete Ξ±' I' F' β"
unfolding assms by (rule tm_cf_discrete_axioms)
mk_ide rf tm_cf_discrete_def[unfolded tm_cf_discrete_axioms_def]
|intro tm_cf_discreteI|
|dest tm_cf_discreteD[dest]|
|elim tm_cf_discreteE[elim]|
lemma tm_cf_discreteI':
assumes "cf_discrete Ξ± I F β"
and "(Ξ»iββ©βI. F i) ββ©β Vset Ξ±"
and "(Ξ»iββ©βI. ββ¦CIdβ¦β¦F iβ¦) ββ©β Vset Ξ±"
shows "tm_cf_discrete Ξ± I F β"
proof-
interpret cf_discrete Ξ± I F β by (rule assms(1))
show ?thesis
by (intro tm_cf_discreteI)
(auto intro: assms cf_discrete_selector_vrange cat_cs_intros)
qed
textβΉElementary properties.βΊ
sublocale tm_cf_discrete β cf_discrete
proof(intro cf_discreteI)
from tm_cf_discrete_ObjMap_in_Vset have "πβ©β (Ξ»iββ©βI. F i) ββ©β Vset Ξ±"
by (cs_concl cs_intro: vdomain_in_VsetI)
then show "I ββ©β Vset Ξ±" by auto
qed (auto intro: cat_cs_intros tm_cf_discrete_selector_vrange)
lemmas (in tm_cf_discrete) tm_cf_discrete_is_cf_discrete_axioms =
cf_discrete_axioms
lemmas [cat_small_discrete_cs_intros] =
tm_cf_discrete.tm_cf_discrete_is_cf_discrete_axioms
lemma (in tm_cf_discrete)
tm_cf_discrete_index_in_Vset[cat_small_discrete_cs_intros]:
"I ββ©β Vset Ξ±"
proof-
from tm_cf_discrete_ObjMap_in_Vset have "πβ©β (Ξ»iββ©βI. F i) ββ©β Vset Ξ±"
by (cs_concl cs_intro: vdomain_in_VsetI)
then show ?thesis by simp
qed
subsubsectionβΉOpposite discrete functor with tiny mapsβΊ
lemma (in tm_cf_discrete) tm_cf_discrete_op[cat_op_intros]:
"tm_cf_discrete Ξ± I F (op_cat β)"
using tm_cf_discrete_ObjMap_in_Vset tm_cf_discrete_ArrMap_in_Vset
by (intro tm_cf_discreteI' cf_discrete_op) (auto simp: cat_op_simps)
lemmas [cat_op_intros] = tm_cf_discrete.tm_cf_discrete_op
subsubsectionβΉDiscrete functor with tiny maps is a functor with tiny mapsβΊ
lemma (in tm_cf_discrete) tm_cf_discrete_the_cf_discrete_is_tm_functor:
":β: I F β : :β©C I β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
by (intro is_tm_functorI' cf_discrete_the_cf_discrete_is_functor)
(
auto simp:
the_cf_discrete_components
tm_cf_discrete_ObjMap_in_Vset
tm_cf_discrete_ArrMap_in_Vset
)
lemma (in tm_cf_discrete) tm_cf_discrete_the_cf_discrete_is_tm_functor':
assumes "π' = :β©C I" and "β' = β"
shows ":β: I F β : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β β'"
unfolding assms by (rule tm_cf_discrete_the_cf_discrete_is_tm_functor)
lemmas [cat_discrete_cs_intros] =
tm_cf_discrete.tm_cf_discrete_the_cf_discrete_is_tm_functor'
textβΉ\newpageβΊ
end
Theory CZH_ECAT_SS
sectionβΉβΉββββΊ and βΉββββΊβΊ
theory CZH_ECAT_SS
imports CZH_ECAT_Small_Functor
begin
subsectionβΉBackgroundβΊ
textβΉ
General information about βΉββββΊ and βΉββββΊ (also known as
cospans and spans, respectively) can be found in in Chapters III-3 and III-4
in \cite{mac_lane_categories_2010}, as well as
nLab \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/cospan}
}\footnote{\url{https://ncatlab.org/nlab/show/span}}.
βΊ
named_theorems cat_ss_cs_simps
named_theorems cat_ss_cs_intros
named_theorems cat_ss_elem_simps
definition π¬β©Sβ©S where [cat_ss_elem_simps]: "π¬β©Sβ©S = 0"
definition πβ©Sβ©S where [cat_ss_elem_simps]: "πβ©Sβ©S = 1β©β"
definition πβ©Sβ©S where [cat_ss_elem_simps]: "πβ©Sβ©S = 2β©β"
definition π€β©Sβ©S where [cat_ss_elem_simps]: "π€β©Sβ©S = 3β©β"
definition π£β©Sβ©S where [cat_ss_elem_simps]: "π£β©Sβ©S = 4β©β"
lemma cat_ss_ineq:
shows cat_ss_ππ[cat_ss_cs_intros]: "πβ©Sβ©S β πβ©Sβ©S"
and cat_ss_ππ¬[cat_ss_cs_intros]: "πβ©Sβ©S β π¬β©Sβ©S"
and cat_ss_ππ¬[cat_ss_cs_intros]: "πβ©Sβ©S β π¬β©Sβ©S"
and cat_ss_π€π£[cat_ss_cs_intros]: "π€β©Sβ©S β π£β©Sβ©S"
and cat_ss_π€π[cat_ss_cs_intros]: "π€β©Sβ©S β πβ©Sβ©S"
and cat_ss_π€π[cat_ss_cs_intros]: "π€β©Sβ©S β πβ©Sβ©S"
and cat_ss_π€π¬[cat_ss_cs_intros]: "π€β©Sβ©S β π¬β©Sβ©S"
and cat_ss_π£π[cat_ss_cs_intros]: "π£β©Sβ©S β πβ©Sβ©S"
and cat_ss_π£π[cat_ss_cs_intros]: "π£β©Sβ©S β πβ©Sβ©S"
and cat_ss_π£π¬[cat_ss_cs_intros]: "π£β©Sβ©S β π¬β©Sβ©S"
unfolding cat_ss_elem_simps by simp_all
lemma (in π΅)
shows cat_ss_π[cat_ss_cs_intros]: "πβ©Sβ©S ββ©β Vset Ξ±"
and cat_ss_π[cat_ss_cs_intros]: "πβ©Sβ©S ββ©β Vset Ξ±"
and cat_ss_π¬[cat_ss_cs_intros]: "π¬β©Sβ©S ββ©β Vset Ξ±"
and cat_ss_π€[cat_ss_cs_intros]: "π€β©Sβ©S ββ©β Vset Ξ±"
and cat_ss_π£[cat_ss_cs_intros]: "π£β©Sβ©S ββ©β Vset Ξ±"
unfolding cat_ss_elem_simps by simp_all
subsectionβΉComposable arrows in βΉββββΊ and βΉββββΊβΊ
abbreviation cat_scospan_composable :: V
where "cat_scospan_composable β‘
(set {π¬β©Sβ©S} Γβ©β set {π¬β©Sβ©S, π€β©Sβ©S, π£β©Sβ©S}) βͺβ©β
(set {π€β©Sβ©S, πβ©Sβ©S} Γβ©β set {πβ©Sβ©S}) βͺβ©β
(set {π£β©Sβ©S, πβ©Sβ©S} Γβ©β set {πβ©Sβ©S})"
abbreviation cat_sspan_composable :: V
where "cat_sspan_composable β‘ (cat_scospan_composable)Β―β©β"
textβΉRules.βΊ
lemma cat_scospan_composable_π¬π¬[cat_ss_cs_intros]:
assumes "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_π¬π€[cat_ss_cs_intros]:
assumes "g = π¬β©Sβ©S" and "f = π€β©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_π¬π£[cat_ss_cs_intros]:
assumes "g = π¬β©Sβ©S" and "f = π£β©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_π€π[cat_ss_cs_intros]:
assumes "g = π€β©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_π£π[cat_ss_cs_intros]:
assumes "g = π£β©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_ππ[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composable_ππ[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_scospan_composable"
using assms by auto
lemma cat_scospan_composableE:
assumes "[g, f]β©β ββ©β cat_scospan_composable"
obtains "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
| "g = π¬β©Sβ©S" and "f = π€β©Sβ©S"
| "g = π¬β©Sβ©S" and "f = π£β©Sβ©S"
| "g = π€β©Sβ©S" and "f = πβ©Sβ©S"
| "g = π£β©Sβ©S" and "f = πβ©Sβ©S"
| "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
| "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
using assms that by auto
lemma cat_sspan_composable_π¬π¬[cat_ss_cs_intros]:
assumes "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_π€π¬[cat_ss_cs_intros]:
assumes "g = π€β©Sβ©S" and "f = π¬β©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_π£π¬[cat_ss_cs_intros]:
assumes "g = π£β©Sβ©S" and "f = π¬β©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_ππ€[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = π€β©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_ππ£[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = π£β©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_ππ[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composable_ππ[cat_ss_cs_intros]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "[g, f]β©β ββ©β cat_sspan_composable"
using assms by auto
lemma cat_sspan_composableE:
assumes "[g, f]β©β ββ©β cat_sspan_composable"
obtains "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
| "g = π€β©Sβ©S" and "f = π¬β©Sβ©S"
| "g = π£β©Sβ©S" and "f = π¬β©Sβ©S"
| "g = πβ©Sβ©S" and "f = π€β©Sβ©S"
| "g = πβ©Sβ©S" and "f = π£β©Sβ©S"
| "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
| "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
using assms that by auto
subsectionβΉCategories βΉββββΊ and βΉββββΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}.βΊ
definition the_cat_scospan :: V (βΉββββ©CβΊ)
where "ββββ©C =
[
set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S},
set {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S},
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| x = π€β©Sβ©S β πβ©Sβ©S
| x = π£β©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
),
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
),
(
Ξ»gfββ©βcat_scospan_composable.
if gf = [π¬β©Sβ©S, π€β©Sβ©S]β©β β π€β©Sβ©S
| gf = [π¬β©Sβ©S, π£β©Sβ©S]β©β β π£β©Sβ©S
| otherwise β gfβ¦0β¦
),
vid_on (set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S})
]β©β"
definition the_cat_sspan :: V (βΉββββ©CβΊ)
where "ββββ©C =
[
set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S},
set {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S},
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
),
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| x = π€β©Sβ©S β πβ©Sβ©S
| x = π£β©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
),
(
Ξ»gfββ©βcat_sspan_composable.
if gf = [πβ©Sβ©S, π€β©Sβ©S]β©β β π€β©Sβ©S
| gf = [πβ©Sβ©S, π£β©Sβ©S]β©β β π£β©Sβ©S
| otherwise β gfβ¦0β¦
),
vid_on (set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S})
]β©β"
textβΉComponents.βΊ
lemma the_cat_scospan_components:
shows "ββββ©Cβ¦Objβ¦ = set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S}"
and "ββββ©Cβ¦Arrβ¦ = set {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}"
and "ββββ©Cβ¦Domβ¦ =
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| x = π€β©Sβ©S β πβ©Sβ©S
| x = π£β©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
)"
and "ββββ©Cβ¦Codβ¦ =
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
)"
and "ββββ©Cβ¦Compβ¦ =
(
Ξ»gfββ©βcat_scospan_composable.
if gf = [π¬β©Sβ©S, π€β©Sβ©S]β©β β π€β©Sβ©S
| gf = [π¬β©Sβ©S, π£β©Sβ©S]β©β β π£β©Sβ©S
| otherwise β gfβ¦0β¦
)"
and "ββββ©Cβ¦CIdβ¦ = vid_on (set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S})"
unfolding the_cat_scospan_def dg_field_simps by (simp_all add: nat_omega_simps)
lemma the_cat_sspan_components:
shows "ββββ©Cβ¦Objβ¦ = set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S}"
and "ββββ©Cβ¦Arrβ¦ = set {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}"
and "ββββ©Cβ¦Domβ¦ =
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
)"
and "ββββ©Cβ¦Codβ¦ =
(
Ξ»xββ©βset {πβ©Sβ©S, π€β©Sβ©S, π¬β©Sβ©S, π£β©Sβ©S, πβ©Sβ©S}.
if x = πβ©Sβ©S β πβ©Sβ©S
| x = πβ©Sβ©S β πβ©Sβ©S
| x = π€β©Sβ©S β πβ©Sβ©S
| x = π£β©Sβ©S β πβ©Sβ©S
| otherwise β π¬β©Sβ©S
)"
and "ββββ©Cβ¦Compβ¦ =
(
Ξ»gfββ©βcat_sspan_composable.
if gf = [πβ©Sβ©S, π€β©Sβ©S]β©β β π€β©Sβ©S
| gf = [πβ©Sβ©S, π£β©Sβ©S]β©β β π£β©Sβ©S
| otherwise β gfβ¦0β¦
)"
and "ββββ©Cβ¦CIdβ¦ = vid_on (set {πβ©Sβ©S, πβ©Sβ©S, π¬β©Sβ©S})"
unfolding the_cat_sspan_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉElementary properties.βΊ
lemma the_cat_scospan_components_vsv[cat_ss_cs_intros]: "vsv (ββββ©C)"
unfolding the_cat_scospan_def by auto
lemma the_cat_sspan_components_vsv[cat_ss_cs_intros]: "vsv (ββββ©C)"
unfolding the_cat_sspan_def by auto
subsubsectionβΉObjectsβΊ
lemma the_cat_scospan_Obj_π¬I[cat_ss_cs_intros]:
assumes "a = π¬β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Obj_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Obj_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_ObjE:
assumes "a ββ©β ββββ©Cβ¦Objβ¦"
obtains βΉa = π¬β©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ
using assms unfolding the_cat_scospan_components by auto
lemma the_cat_sspan_Obj_π¬I[cat_ss_cs_intros]:
assumes "a = π¬β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Obj_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Obj_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Objβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_ObjE:
assumes "a ββ©β ββββ©Cβ¦Objβ¦"
obtains βΉa = π¬β©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ
using assms unfolding the_cat_sspan_components by auto
subsubsectionβΉArrowsβΊ
lemma the_cat_scospan_Arr_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Arr_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Arr_π¬I[cat_ss_cs_intros]:
assumes "a = π¬β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Arr_π€I[cat_ss_cs_intros]:
assumes "a = π€β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_Arr_π£I[cat_ss_cs_intros]:
assumes "a = π£β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_scospan_components by simp
lemma the_cat_scospan_ArrE:
assumes "f ββ©β ββββ©Cβ¦Arrβ¦"
obtains βΉf = πβ©Sβ©SβΊ | βΉf = πβ©Sβ©SβΊ | βΉf = π¬β©Sβ©SβΊ | βΉf = π€β©Sβ©SβΊ | βΉf = π£β©Sβ©SβΊ
using assms unfolding the_cat_scospan_components by auto
lemma the_cat_sspan_Arr_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Arr_πI[cat_ss_cs_intros]:
assumes "a = πβ©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Arr_π¬I[cat_ss_cs_intros]:
assumes "a = π¬β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Arr_π€I[cat_ss_cs_intros]:
assumes "a = π€β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_Arr_π£I[cat_ss_cs_intros]:
assumes "a = π£β©Sβ©S"
shows "a ββ©β ββββ©Cβ¦Arrβ¦"
using assms unfolding the_cat_sspan_components by simp
lemma the_cat_sspan_ArrE:
assumes "f ββ©β ββββ©Cβ¦Arrβ¦"
obtains βΉf = πβ©Sβ©SβΊ | βΉf = πβ©Sβ©SβΊ | βΉf = π¬β©Sβ©SβΊ | βΉf = π€β©Sβ©SβΊ | βΉf = π£β©Sβ©SβΊ
using assms unfolding the_cat_sspan_components by auto
subsubsectionβΉDomainβΊ
mk_VLambda the_cat_scospan_components(3)
|vsv the_cat_scospan_Dom_vsv[cat_ss_cs_intros]|
|vdomain the_cat_scospan_Dom_vdomain[cat_ss_cs_simps]|
lemma the_cat_scospan_Dom_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms by simp
lemma the_cat_scospan_Dom_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms by simp
lemma the_cat_scospan_Dom_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
lemma the_cat_scospan_Dom_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
lemma the_cat_scospan_Dom_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
mk_VLambda the_cat_sspan_components(3)
|vsv the_cat_sspan_Dom_vsv[cat_ss_cs_intros]|
|vdomain the_cat_sspan_Dom_vdomain[cat_ss_cs_simps]|
lemma the_cat_sspan_Dom_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms by simp
lemma the_cat_sspan_Dom_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms by simp
lemma the_cat_sspan_Dom_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
lemma the_cat_sspan_Dom_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
lemma the_cat_sspan_Dom_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "ββββ©Cβ¦Domβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
subsubsectionβΉCodomainβΊ
mk_VLambda the_cat_scospan_components(4)
|vsv the_cat_scospan_Cod_vsv[cat_ss_cs_intros]|
|vdomain the_cat_scospan_Cod_vdomain[cat_ss_cs_simps]|
lemma the_cat_scospan_Cod_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms by simp
lemma the_cat_scospan_Cod_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_scospan_components assms by simp
lemma the_cat_scospan_Cod_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
lemma the_cat_scospan_Cod_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
lemma the_cat_scospan_Cod_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_scospan_components assms using cat_ss_ineq by auto
mk_VLambda the_cat_sspan_components(4)
|vsv the_cat_sspan_Cod_vsv[cat_ss_cs_intros]|
|vdomain the_cat_sspan_Cod_vdomain[cat_ss_cs_simps]|
lemma the_cat_sspan_Cod_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms by simp
lemma the_cat_sspan_Cod_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms by simp
lemma the_cat_sspan_Cod_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = π¬β©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
lemma the_cat_sspan_Cod_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
lemma the_cat_sspan_Cod_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "ββββ©Cβ¦Codβ¦β¦fβ¦ = πβ©Sβ©S"
unfolding the_cat_sspan_components assms using cat_ss_ineq by auto
subsubsectionβΉCompositionβΊ
mk_VLambda the_cat_scospan_components(5)
|vsv the_cat_scospan_Comp_vsv[cat_ss_cs_intros]|
|vdomain the_cat_scospan_Comp_vdomain[cat_ss_cs_simps]|
lemma the_cat_scospan_Comp_app_ππ[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_ππ[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_π¬π¬[cat_ss_cs_simps]:
assumes "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_scospan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_π¬π€[cat_ss_cs_simps]:
assumes "g = π¬β©Sβ©S" and "f = π€β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_π¬π£[cat_ss_cs_simps]:
assumes "g = π¬β©Sβ©S" and "f = π£β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_scospan_components(5) assms by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_π€π[cat_ss_cs_simps]:
assumes "g = π€β©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = g"
unfolding the_cat_scospan_components(5) assms
using cat_ss_ineq
by (auto simp: nat_omega_simps)
qed
lemma the_cat_scospan_Comp_app_π£π[cat_ss_cs_simps]:
assumes "g = π£β©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_scospan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = g"
unfolding the_cat_scospan_components(5) assms
using cat_ss_ineq
by (auto simp: nat_omega_simps)
qed
mk_VLambda the_cat_sspan_components(5)
|vsv the_cat_sspan_Comp_vsv[cat_ss_cs_intros]|
|vdomain the_cat_sspan_Comp_vdomain[cat_ss_cs_simps]|
lemma the_cat_sspan_Comp_app_ππ[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_ππ[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_π¬π¬[cat_ss_cs_simps]:
assumes "g = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
with assms show "g ββ©Aβββββ©Cβ f = g" "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_sspan_components(5) by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_ππ€[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = π€β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_ππ£[cat_ss_cs_simps]:
assumes "g = πβ©Sβ©S" and "f = π£β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = f"
unfolding the_cat_sspan_components(5) assms by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_π€π¬[cat_ss_cs_simps]:
assumes "g = π€β©Sβ©S" and "f = π¬β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = g"
unfolding the_cat_sspan_components(5) assms
using cat_ss_ineq
by (auto simp: nat_omega_simps)
qed
lemma the_cat_sspan_Comp_app_π£π¬[cat_ss_cs_simps]:
assumes "g = π£β©Sβ©S" and "f = π¬β©Sβ©S"
shows "g ββ©Aβββββ©Cβ f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_sspan_composable" by auto
then show "g ββ©Aβββββ©Cβ f = g"
unfolding the_cat_sspan_components(5) assms
using cat_ss_ineq
by (auto simp: nat_omega_simps)
qed
subsubsectionβΉIdentityβΊ
mk_VLambda the_cat_scospan_components(6)[folded VLambda_vid_on]
|vsv the_cat_scospan_CId_vsv[cat_ss_cs_intros]|
|vdomain the_cat_scospan_CId_vdomain[cat_ss_cs_simps]|
|app the_cat_scospan_CId_app[cat_ss_cs_simps]|
mk_VLambda the_cat_sspan_components(6)[folded VLambda_vid_on]
|vsv the_cat_sspan_CId_vsv[cat_ss_cs_intros]|
|vdomain the_cat_sspan_CId_vdomain[cat_ss_cs_simps]|
|app the_cat_sspan_CId_app[cat_ss_cs_simps]|
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma the_cat_scospan_is_arr_πππ[cat_ss_cs_intros]:
assumes "a' = πβ©Sβ©S" and "b' = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "f : a' β¦βββββ©Cβ b'"
proof(intro is_arrI, unfold assms)
show "ββββ©Cβ¦Domβ¦β¦πβ©Sβ©Sβ¦ = πβ©Sβ©S" "ββββ©Cβ¦Codβ¦β¦πβ©Sβ©Sβ¦ = πβ©Sβ©S"
by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)
lemma the_cat_scospan_is_arr_πππ[cat_ss_cs_intros]:
assumes "a' = πβ©Sβ©S" and "b' = πβ©Sβ©S" and "f = πβ©Sβ©S"
shows "f : a' β¦βββββ©Cβ b'"
proof(intro is_arrI, unfold assms)
show "ββββ©Cβ¦Domβ¦β¦πβ©Sβ©Sβ¦ = πβ©Sβ©S" "ββββ©Cβ¦Codβ¦β¦πβ©Sβ©Sβ¦ = πβ©Sβ©S"
by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)
lemma the_cat_scospan_is_arr_π¬π¬π¬[cat_ss_cs_intros]:
assumes "a' = π¬β©Sβ©S" and "b' = π¬β©Sβ©S" and "f = π¬β©Sβ©S"
shows "f : a' β¦βββββ©Cβ b'"
proof(intro is_arrI, unfold assms)
show "ββββ©Cβ¦Domβ¦β¦π¬β©Sβ©Sβ¦ = π¬β©Sβ©S" "ββββ©Cβ¦Codβ¦β¦π¬β©Sβ©Sβ¦ = π¬β©Sβ©S"
by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)
lemma the_cat_scospan_is_arr_ππ¬π€[cat_ss_cs_intros]:
assumes "a' = πβ©Sβ©S" and "b' = π¬β©Sβ©S" and "f = π€β©Sβ©S"
shows "f : a' β¦βββββ©Cβ b'"
proof(intro is_arrI, unfold assms)
show "ββββ©Cβ¦Domβ¦β¦π€β©Sβ©Sβ¦ = πβ©Sβ©S" "ββββ©Cβ¦Codβ¦β¦π€β©Sβ©Sβ¦ = π¬β©Sβ©S"
by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)
lemma the_cat_scospan_is_arr_ππ¬π£[cat_ss_cs_intros]:
assumes "a' = πβ©Sβ©S" and "b' = π¬β©Sβ©S" and "f = π£β©Sβ©S"
shows "f : a' β¦βββββ©Cβ b'"
proof(intro is_arrI, unfold assms)
show "ββββ©Cβ¦Domβ¦β¦π£β©Sβ©Sβ¦ = πβ©Sβ©S" "ββββ©Cβ¦Codβ¦β¦π£β©Sβ©Sβ¦ = π¬β©Sβ©S"
by (cs_concl cs_simp: cat_ss_cs_simps)+
qed (auto simp: the_cat_scospan_components)
lemma the_cat_scospan_is_arrE:
assumes "f' : a' β¦βββββ©Cβ b'"
obtains "a' = πβ©Sβ©S" and "b' = πβ©Sβ©S" and "f' = πβ©Sβ©S"
| "a' = πβ©Sβ©S" and "b' = πβ©Sβ©S" and "f' = πβ©Sβ©S"
| "a' = π¬β©Sβ©S" and "b' = π¬β©Sβ©S" and "f' = π¬β©Sβ©S"
| "a' = πβ©Sβ©S" and "b' = π¬β©Sβ©S" and "f' = π€β©Sβ©S"
| "a' = πβ©Sβ©S" and "b' = π¬β©Sβ©S" and "f' = π£β©Sβ©S"
proof-
note f = is_arrD[OF assms]
from f(1) consider (πβ©Sβ©S) βΉf' = πβ©Sβ©SβΊ
| (πβ©Sβ©S) βΉf' = πβ©Sβ©SβΊ
| (π¬β©Sβ©S) βΉf' = π¬β©Sβ©SβΊ
| (π€β©Sβ©S) βΉf' = π€β©Sβ©SβΊ
| (π£β©Sβ©S) βΉf' = π£β©Sβ©SβΊ
by (elim the_cat_scospan_ArrE)
then show ?thesis
proof cases
case πβ©Sβ©S
moreover from f(2,3)[unfolded πβ©Sβ©S, symmetric] have "a' = πβ©Sβ©S" "b' = πβ©Sβ©S"
by (simp_all add: cat_ss_cs_simps)
ultimately show ?thesis using that by auto
next
case πβ©Sβ©S
moreover from f(2,3)[unfolded πβ©Sβ©S, symmetric] have "a' = πβ©Sβ©S" "b' = πβ©Sβ©S"
by (simp_all add: cat_ss_cs_simps)
ultimately show ?thesis using that by auto
next
case π¬β©Sβ©S
moreover from f(2,3)[unfolded π¬β©Sβ©S, symmetric] have "a' = π¬β©Sβ©S" "b' = π¬β©Sβ©S"
by (simp_all add: cat_ss_cs_simps)
ultimately show ?thesis using that by auto
next
case π€β©Sβ©S
moreover have "a' = πβ©Sβ©S" "b' = π¬β©Sβ©S"
by (simp_all add: f(2,3)[unfolded π€β©Sβ©S, symmetric] cat_ss_cs_simps)
ultimately show ?thesis using that by auto
next
case π£β©Sβ©S
moreover have "a' = πβ©Sβ©S" "b' = π¬β©Sβ©S"
by (simp_all add: f(2,3)[unfolded π£β©Sβ©S, symmetric] cat_ss_cs_simps)
ultimately show ?thesis using that by auto
qed
qed
subsubsectionβΉβΉββββΊ is a finite categoryβΊ
lemma (in π΅) finite_category_the_cat_scospan[cat_ss_cs_intros]:
"finite_category Ξ± (ββββ©C)"
proof(intro finite_categoryI'' tiny_categoryI'')
show "vfsequence (ββββ©C)" unfolding the_cat_scospan_def by simp
show "vcard (ββββ©C) = 6β©β"
unfolding the_cat_scospan_def by (simp_all add: nat_omega_simps)
show "ββ©β (ββββ©Cβ¦Domβ¦) ββ©β ββββ©Cβ¦Objβ¦" by (auto simp: the_cat_scospan_components)
show "ββ©β (ββββ©Cβ¦Codβ¦) ββ©β ββββ©Cβ¦Objβ¦" by (auto simp: the_cat_scospan_components)
show "(gf ββ©β πβ©β (ββββ©Cβ¦Compβ¦)) =
(βg f b c a. gf = [g, f]β©β β§ g : b β¦βββββ©Cβ c β§ f : a β¦βββββ©Cβ b)"
for gf
unfolding the_cat_scospan_Comp_vdomain
proof
assume prems: "gf ββ©β cat_scospan_composable"
then obtain g f where gf_def: "gf = [g, f]β©β" by auto
from prems show
"βg f b c a. gf = [g, f]β©β β§ g : b β¦βββββ©Cβ c β§ f : a β¦βββββ©Cβ b"
unfolding gf_def
by
(
cases rule: cat_scospan_composableE;
(intro exI conjI)?;
cs_concl_step?;
(simp only:)?,
allβΉintro is_arrI, unfold the_cat_scospan_components(2)βΊ
)
(cs_concl cs_simp: cat_ss_cs_simps V_cs_simps cs_intro: V_cs_intros)+
next
assume prems:
"βg f b' c' a'. gf = [g, f]β©β β§ g : b' β¦βββββ©Cβ c' β§ f : a' β¦βββββ©Cβ b'"
then obtain g f b c a
where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦βββββ©Cβ c"
and f: "f : a β¦βββββ©Cβ b"
by clarsimp
from g f show "gf ββ©β cat_scospan_composable"
unfolding gf_def
by (elim the_cat_scospan_is_arrE) (auto simp: cat_ss_cs_intros)
qed
show "πβ©β (ββββ©Cβ¦CIdβ¦) = ββββ©Cβ¦Objβ¦"
by (simp add: cat_ss_cs_simps the_cat_scospan_components)
show "g ββ©Aβββββ©Cβ f : a β¦βββββ©Cβ c"
if "g : b β¦βββββ©Cβ c" and "f : a β¦βββββ©Cβ b" for b c g a f
using that
by (elim the_cat_scospan_is_arrE; simp only:)
(
allβΉ
solvesβΉsimp add: cat_ss_ineq cat_ss_ineq[symmetric]βΊ |
cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
βΊ
)
show "h ββ©Aβββββ©Cβ g ββ©Aβββββ©Cβ f = h ββ©Aβββββ©Cβ (g ββ©Aβββββ©Cβ f)"
if "h : c β¦βββββ©Cβ d" and "g : b β¦βββββ©Cβ c" and "f : a β¦βββββ©Cβ b"
for c d h b g a f
using that
by (elim the_cat_scospan_is_arrE; simp only:)
(
allβΉ
solvesβΉsimp only: cat_ss_ineq cat_ss_ineq[symmetric]βΊ |
cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros
βΊ
)
show "ββββ©Cβ¦CIdβ¦β¦aβ¦ : a β¦βββββ©Cβ a" if "a ββ©β ββββ©Cβ¦Objβ¦" for a
using that
by (elim the_cat_scospan_ObjE)
(
allβΉ
cs_concl
cs_simp: V_cs_simps cat_ss_cs_simps
cs_intro: V_cs_intros cat_ss_cs_intros
βΊ
)
show "ββββ©Cβ¦CIdβ¦β¦bβ¦ ββ©Aβββββ©Cβ f = f" if "f : a β¦βββββ©Cβ b" for a b f
using that
by (elim the_cat_scospan_is_arrE)
(
cs_concl
cs_simp: V_cs_simps cat_ss_cs_simps
cs_intro: V_cs_intros cat_ss_cs_intros
)+
show "f ββ©Aβββββ©Cβ ββββ©Cβ¦CIdβ¦β¦bβ¦ = f" if "f : b β¦βββββ©Cβ c" for b c f
using that
by (elim the_cat_scospan_is_arrE)
(
cs_concl
cs_simp: V_cs_simps cat_ss_cs_simps
cs_intro: V_cs_intros cat_ss_cs_intros
)+
qed
(
cs_concl
cs_simp: V_cs_simps cat_ss_cs_simps the_cat_scospan_components(1,2)
cs_intro: cat_cs_intros cat_ss_cs_intros V_cs_intros
)+
lemmas [cat_ss_cs_intros] = π΅.finite_category_the_cat_scospan
subsubsectionβΉDuality for βΉββββΊ and βΉββββΊβΊ
lemma the_cat_scospan_op[cat_op_simps]: "op_cat (ββββ©C) = ββββ©C"
proof-
have dom_lhs: "πβ©β (op_cat (ββββ©C)) = 6β©β"
unfolding op_cat_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (ββββ©C) = 6β©β"
unfolding the_cat_sspan_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "a ββ©β 6β©β βΉ op_cat (ββββ©C)β¦aβ¦ = ββββ©Cβ¦aβ¦" for a
proof
(
elim_in_numeral,
fold dg_field_simps,
unfold op_cat_components;
rule sym
)
show "ββββ©Cβ¦Compβ¦ = fflip (ββββ©Cβ¦Compβ¦)"
proof(rule vsv_eqI, unfold cat_ss_cs_simps vdomain_fflip)
fix gf assume prems: "gf ββ©β cat_sspan_composable"
then obtain g f where gf_def: "gf = [g, f]β©β" by auto
from prems have fg: "[f, g]β©β ββ©β cat_scospan_composable"
unfolding gf_def by auto
have [cat_ss_cs_simps]: "g ββ©Aβββββ©Cβ f = f ββ©Aβββββ©Cβ g"
if "[f, g]β©β ββ©β cat_scospan_composable"
using that
by (elim cat_scospan_composableE; simp only:)
(cs_concl cs_simp: cat_ss_cs_simps cs_intro: cat_ss_cs_intros)+
from fg show
"ββββ©Cβ¦Compβ¦β¦gfβ¦ = fflip (ββββ©Cβ¦Compβ¦)β¦gfβ¦"
unfolding gf_def by (cs_concl cs_simp: cat_ss_cs_simps fflip_app)
qed (auto intro: fflip_vsv cat_ss_cs_intros)
qed (unfold the_cat_sspan_components the_cat_scospan_components, simp_all)
qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed
lemma (in π΅) the_cat_sspan_op[cat_op_simps]: "op_cat (ββββ©C) = ββββ©C"
proof-
interpret scospan: finite_category Ξ± βΉββββ©CβΊ
by (rule finite_category_the_cat_scospan)
interpret sspan: finite_category Ξ± βΉββββ©CβΊ
by (rule scospan.finite_category_op[unfolded cat_op_simps])
from the_cat_scospan_op have "op_cat (ββββ©C) = op_cat (op_cat (ββββ©C))" by simp
also have "β¦ = ββββ©C" by (cs_concl cs_simp: cat_op_simps)
finally show ?thesis by auto
qed
lemmas [cat_op_simps] = π΅.the_cat_sspan_op
subsubsectionβΉβΉββββΊ is a finite categoryβΊ
lemma (in π΅) finite_category_the_cat_sspan[cat_ss_cs_intros]:
"finite_category Ξ± (ββββ©C)"
proof-
interpret scospan: finite_category Ξ± βΉββββ©CβΊ
by (rule finite_category_the_cat_scospan)
show ?thesis by (rule scospan.finite_category_op[unfolded cat_op_simps])
qed
subsectionβΉLocal assumptions for functors from βΉββββΊ and βΉββββΊβΊ
textβΉ
The functors from βΉββββΊ and βΉββββΊ are introduced as
convenient abstractions for the definition of the
pullbacks and the pushouts (e.g., see Chapter III-3 and
Chapter III-4 in \cite{mac_lane_categories_2010}).
βΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
locale cf_scospan = category Ξ± β for Ξ± π π€ π¬ π£ π β +
assumes cf_scospan_π€[cat_ss_cs_intros]: "π€ : π β¦βββ π¬"
and cf_scospan_π£[cat_ss_cs_intros]: "π£ : π β¦βββ π¬"
lemma (in cf_scospan) cf_scospan_π€'[cat_ss_cs_intros]:
assumes "a = π" and "b = π¬"
shows "π€ : a β¦βββ b"
unfolding assms by (rule cf_scospan_π€)
lemma (in cf_scospan) cf_scospan_π€''[cat_ss_cs_intros]:
assumes "g = π€" and "b = π¬"
shows "g : π β¦βββ b"
unfolding assms by (rule cf_scospan_π€)
lemma (in cf_scospan) cf_scospan_π€'''[cat_ss_cs_intros]:
assumes "g = π€" and "a = π"
shows "g : a β¦βββ π¬"
unfolding assms by (rule cf_scospan_π€)
lemma (in cf_scospan) cf_scospan_π£'[cat_ss_cs_intros]:
assumes "a = π" and "b = π¬"
shows "π£ : a β¦βββ b"
unfolding assms by (rule cf_scospan_π£)
lemma (in cf_scospan) cf_scospan_π£''[cat_ss_cs_intros]:
assumes "f = π£" and "b = π¬"
shows "f : π β¦βββ b"
unfolding assms by (rule cf_scospan_π£)
lemma (in cf_scospan) cf_scospan_π£'''[cat_ss_cs_intros]:
assumes "g = π£" and "b = π"
shows "g : b β¦βββ π¬"
unfolding assms by (rule cf_scospan_π£)
locale cf_sspan = category Ξ± β for Ξ± π π€ π¬ π£ π and β +
assumes cf_sspan_π€[cat_ss_cs_intros]: "π€ : π¬ β¦βββ π"
and cf_sspan_π£[cat_ss_cs_intros]: "π£ : π¬ β¦βββ π"
lemma (in cf_sspan) cf_sspan_π€'[cat_ss_cs_intros]:
assumes "a = π¬" and "b = π"
shows "π€ : a β¦βββ b"
unfolding assms by (rule cf_sspan_π€)
lemma (in cf_sspan) cf_sspan_π€''[cat_ss_cs_intros]:
assumes "g = π€" and "a = π"
shows "g : π¬ β¦βββ a"
unfolding assms by (rule cf_sspan_π€)
lemma (in cf_sspan) cf_sspan_π€'''[cat_ss_cs_intros]:
assumes "g = π€" and "a = π¬"
shows "g : a β¦βββ π"
unfolding assms by (rule cf_sspan_π€)
lemma (in cf_sspan) cf_sspan_π£'[cat_ss_cs_intros]:
assumes "a = π¬" and "b = π"
shows "π£ : a β¦βββ b"
unfolding assms by (rule cf_sspan_π£)
lemma (in cf_sspan) cf_sspan_π£''[cat_ss_cs_intros]:
assumes "f = π£" and "b = π"
shows "f : π¬ β¦βββ b"
unfolding assms by (rule cf_sspan_π£)
lemma (in cf_sspan) cf_sspan_π£'''[cat_ss_cs_intros]:
assumes "f = π£" and "b = π¬"
shows "f : b β¦βββ π"
unfolding assms by (rule cf_sspan_π£)
textβΉRules.βΊ
lemmas (in cf_scospan) [cat_ss_cs_intros] = cf_scospan_axioms
mk_ide rf cf_scospan_def[unfolded cf_scospan_axioms_def]
|intro cf_scospanI|
|dest cf_scospanD[dest]|
|elim cf_scospanE[elim]|
lemmas [cat_ss_cs_intros] = cf_scospanD(1)
lemmas (in cf_sspan) [cat_ss_cs_intros] = cf_sspan_axioms
mk_ide rf cf_sspan_def[unfolded cf_sspan_axioms_def]
|intro cf_sspanI|
|dest cf_sspanD[dest]|
|elim cf_sspanE[elim]|
textβΉDuality.βΊ
lemma (in cf_scospan) cf_sspan_op[cat_op_intros]:
"cf_sspan Ξ± π π€ π¬ π£ π (op_cat β)"
by (intro cf_sspanI, unfold cat_op_simps)
(cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+
lemmas [cat_op_intros] = cf_scospan.cf_sspan_op
lemma (in cf_sspan) cf_scospan_op[cat_op_intros]:
"cf_scospan Ξ± π π€ π¬ π£ π (op_cat β)"
by (intro cf_scospanI, unfold cat_op_simps)
(cs_concl cs_intro: cat_cs_intros cat_op_intros cat_ss_cs_intros)+
lemmas [cat_op_intros] = cf_sspan.cf_scospan_op
subsectionβΉFunctors from βΉββββΊ and βΉββββΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition the_cf_scospan :: "V β V β V β V β V β V β V"
(βΉβ¨_β_β_β_β_β©β©Cβ©FΔ±βΊ [51, 51, 51, 51, 51] 999)
where "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ =
[
(
Ξ»aββ©βββββ©Cβ¦Objβ¦.
if a = πβ©Sβ©S β π
| a = πβ©Sβ©S β π
| otherwise β π¬
),
(
Ξ»fββ©βββββ©Cβ¦Arrβ¦.
if f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = π€β©Sβ©S β π€
| f = π£β©Sβ©S β π£
| otherwise β ββ¦CIdβ¦β¦π¬β¦
),
ββββ©C,
β
]β©β"
definition the_cf_sspan :: "V β V β V β V β V β V β V"
(βΉβ¨_β_β_β_β_β©β©Cβ©FΔ±βΊ [51, 51, 51, 51, 51] 999)
where "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ =
[
(
Ξ»aββ©βββββ©Cβ¦Objβ¦.
if a = πβ©Sβ©S β π
| a = πβ©Sβ©S β π
| otherwise β π¬
),
(
Ξ»fββ©βββββ©Cβ¦Arrβ¦.
if f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = π€β©Sβ©S β π€
| f = π£β©Sβ©S β π£
| otherwise β ββ¦CIdβ¦β¦π¬β¦
),
ββββ©C,
β
]β©β"
textβΉComponents.βΊ
lemma the_cf_scospan_components:
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦ =
(
Ξ»aββ©βββββ©Cβ¦Objβ¦.
if a = πβ©Sβ©S β π
| a = πβ©Sβ©S β π
| otherwise β π¬
)"
and "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦ =
(
Ξ»fββ©βββββ©Cβ¦Arrβ¦.
if f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = π€β©Sβ©S β π€
| f = π£β©Sβ©S β π£
| otherwise β ββ¦CIdβ¦β¦π¬β¦
)"
and [cat_ss_cs_simps]: "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦HomDomβ¦ = ββββ©C"
and [cat_ss_cs_simps]: "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦HomCodβ¦ = β"
unfolding the_cf_scospan_def dghm_field_simps by (simp_all add: nat_omega_simps)
lemma the_cf_sspan_components:
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦ =
(
Ξ»aββ©βββββ©Cβ¦Objβ¦.
if a = πβ©Sβ©S β π
| a = πβ©Sβ©S β π
| otherwise β π¬
)"
and "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦ =
(
Ξ»fββ©βββββ©Cβ¦Arrβ¦.
if f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = πβ©Sβ©S β ββ¦CIdβ¦β¦πβ¦
| f = π€β©Sβ©S β π€
| f = π£β©Sβ©S β π£
| otherwise β ββ¦CIdβ¦β¦π¬β¦
)"
and [cat_ss_cs_simps]: "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦HomDomβ¦ = ββββ©C"
and [cat_ss_cs_simps]: "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦HomCodβ¦ = β"
unfolding the_cf_sspan_def dghm_field_simps
by (simp_all add: nat_omega_simps)
textβΉElementary properties.βΊ
lemma the_cf_scospan_components_vsv[cat_ss_cs_intros]: "vsv (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)"
unfolding the_cf_scospan_def by auto
lemma the_cf_sspan_components_vsv[cat_ss_cs_intros]: "vsv (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)"
unfolding the_cf_sspan_def by auto
subsubsectionβΉObject map.βΊ
mk_VLambda the_cf_scospan_components(1)
|vsv the_cf_scospan_ObjMap_vsv[cat_ss_cs_intros]|
|vdomain the_cf_scospan_ObjMap_vdomain[cat_ss_cs_simps]|
|app the_cf_scospan_ObjMap_app|
lemma the_cf_scospan_ObjMap_app_π[cat_ss_cs_simps]:
assumes "x = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π"
by
(
cs_concl
cs_simp: the_cf_scospan_ObjMap_app V_cs_simps assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ObjMap_app_π[cat_ss_cs_simps]:
assumes "x = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ObjMap_app_π¬[cat_ss_cs_simps]:
assumes "x = π¬β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π¬"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ObjMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ObjMap_vrange:
"ββ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold the_cf_scospan_ObjMap_vdomain,
intro the_cf_scospan_ObjMap_vsv
)
fix a assume "a ββ©β ββββ©Cβ¦Objβ¦"
then consider βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = π¬β©Sβ©SβΊ
unfolding the_cat_scospan_components by auto
then show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦aβ¦ ββ©β ββ¦Objβ¦"
by cases
(
cs_concl
cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed
mk_VLambda the_cf_sspan_components(1)
|vsv the_cf_sspan_ObjMap_vsv[cat_ss_cs_intros]|
|vdomain the_cf_sspan_ObjMap_vdomain[cat_ss_cs_simps]|
|app the_cf_sspan_ObjMap_app|
lemma the_cf_sspan_ObjMap_app_π[cat_ss_cs_simps]:
assumes "x = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π"
by
(
cs_concl
cs_simp: the_cf_sspan_ObjMap_app V_cs_simps assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ObjMap_app_π[cat_ss_cs_simps]:
assumes "x = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ObjMap_app_π¬[cat_ss_cs_simps]:
assumes "x = π¬β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦xβ¦ = π¬"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ObjMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ObjMap_vrange:
"ββ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold the_cf_sspan_ObjMap_vdomain,
intro the_cf_sspan_ObjMap_vsv
)
fix a assume "a ββ©β ββββ©Cβ¦Objβ¦"
then consider βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = π¬β©Sβ©SβΊ
unfolding the_cat_sspan_components by auto
then show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦aβ¦ ββ©β ββ¦Objβ¦"
by cases
(
cs_concl
cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed
subsubsectionβΉArrow map.βΊ
mk_VLambda the_cf_scospan_components(2)
|vsv the_cf_scospan_ArrMap_vsv[cat_ss_cs_intros]|
|vdomain the_cf_scospan_ArrMap_vdomain[cat_ss_cs_simps]|
|app the_cf_scospan_ArrMap_app|
lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦π¬β¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦πβ¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦πβ¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = π€"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ArrMap_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = π£"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_scospan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_scospan) the_cf_scospan_ArrMap_vrange:
"ββ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold the_cf_scospan_ArrMap_vdomain,
intro the_cf_scospan_ArrMap_vsv
)
fix a assume "a ββ©β ββββ©Cβ¦Arrβ¦"
then consider βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = π¬β©Sβ©SβΊ | βΉa = π€β©Sβ©SβΊ | βΉa = π£β©Sβ©SβΊ
unfolding the_cat_scospan_components by auto
then show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦aβ¦ ββ©β ββ¦Arrβ¦"
by cases
(
cs_concl
cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed
mk_VLambda the_cf_sspan_components(2)
|vsv the_cf_sspan_ArrMap_vsv[cat_ss_cs_intros]|
|vdomain the_cf_sspan_ArrMap_vdomain[cat_ss_cs_simps]|
|app the_cf_sspan_ArrMap_app|
lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π¬[cat_ss_cs_simps]:
assumes "f = π¬β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦π¬β¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦πβ¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π[cat_ss_cs_simps]:
assumes "f = πβ©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦πβ¦"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π€[cat_ss_cs_simps]:
assumes "f = π€β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = π€"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ArrMap_app_π£[cat_ss_cs_simps]:
assumes "f = π£β©Sβ©S"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ = π£"
using cat_ss_ineq
by
(
cs_concl
cs_simp: V_cs_simps the_cf_sspan_ArrMap_app assms
cs_intro: cat_ss_cs_intros
)
lemma (in cf_sspan) the_cf_sspan_ArrMap_vrange:
"ββ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof
(
intro vsv.vsv_vrange_vsubset,
unfold the_cf_sspan_ArrMap_vdomain,
intro the_cf_sspan_ArrMap_vsv
)
fix a assume "a ββ©β ββββ©Cβ¦Arrβ¦"
then consider βΉa = πβ©Sβ©SβΊ | βΉa = πβ©Sβ©SβΊ | βΉa = π¬β©Sβ©SβΊ | βΉa = π€β©Sβ©SβΊ | βΉa = π£β©Sβ©SβΊ
unfolding the_cat_sspan_components by auto
then show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦aβ¦ ββ©β ββ¦Arrβ¦"
by cases
(
cs_concl
cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed
subsubsectionβΉFunctor from βΉββββΊ is a functorβΊ
lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor:
"β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof(intro is_functor.cf_is_tm_functor_if_HomDom_finite_category is_functorI')
show "vfsequence (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)"
unfolding the_cf_scospan_def by auto
show "vcard (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ) = 4β©β"
unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦ :
β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦aβ¦ β¦βββ β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βββββ©Cβ b" for a b f
using that
by (cases rule: the_cat_scospan_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_ss_cs_simps cs_intro: cat_cs_intros cat_ss_cs_intros
)+
show "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦g ββ©Aβββββ©Cβ fβ¦ =
β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦gβ¦ ββ©Aβββ β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βββββ©Cβ c" and "f : a β¦βββββ©Cβ b" for b c g a f
using that
by (elim the_cat_scospan_is_arrE)
(
allβΉsimp only:βΊ,
allβΉ
solvesβΉsimp add: cat_ss_ineq cat_ss_ineq[symmetric]βΊ |
cs_concl
cs_simp: cat_cs_simps cat_ss_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
βΊ
)
show
"β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ArrMapβ¦β¦ββββ©Cβ¦CIdβ¦β¦cβ¦β¦ =
ββ¦CIdβ¦β¦β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fββββ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β ββββ©Cβ¦Objβ¦" for c
using that
by (elim the_cat_scospan_ObjE; simp only:)
(
cs_concl
cs_simp: V_cs_simps cat_ss_cs_simps
cs_intro: V_cs_intros cat_ss_cs_intros
)+
qed
(
cs_concl
cs_simp: cat_ss_cs_simps
cs_intro:
the_cf_scospan_ObjMap_vrange
cat_ss_cs_intros cat_cs_intros cat_small_cs_intros
)+
lemma (in cf_scospan) cf_scospan_the_cf_scospan_is_tm_functor':
assumes "π' = ββββ©C" and "β' = β"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β β'"
unfolding assms by (rule cf_scospan_the_cf_scospan_is_tm_functor)
lemmas [cat_ss_cs_intros] = cf_scospan.cf_scospan_the_cf_scospan_is_tm_functor
subsubsectionβΉDuality for the functors from βΉββββΊ and βΉββββΊβΊ
lemma op_cf_cf_scospan[cat_op_simps]:
"op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ) = β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat ββ"
proof-
have dom_lhs: "πβ©β (op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)) = 4β©β"
unfolding op_cf_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat ββ) = 4β©β"
unfolding the_cf_sspan_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)β¦aβ¦ = β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat βββ¦aβ¦"
if "a ββ©β 4β©β" for a
using that
by
(
elim_in_numeral,
fold dghm_field_simps,
unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
)
(
simp_all add:
the_cat_scospan_components(1,2)
the_cat_sspan_components(1,2)
cat_op_simps
)
qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed
lemma (in π΅) op_cf_cf_scospan[cat_op_simps]:
"op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ) = β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat ββ"
proof-
have dom_lhs: "πβ©β (op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)) = 4β©β"
unfolding op_cf_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat ββ) = 4β©β"
unfolding the_cf_scospan_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "op_cf (β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ)β¦aβ¦ = β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat βββ¦aβ¦"
if "a ββ©β 4β©β" for a
using that
by
(
elim_in_numeral,
fold dghm_field_simps,
unfold cat_op_simps the_cf_sspan_components the_cf_scospan_components
)
(
simp_all add:
the_cat_scospan_components(1,2)
the_cat_sspan_components(1,2)
cat_op_simps
)
qed (auto intro: cat_op_intros cat_ss_cs_intros)
qed
lemmas [cat_op_simps] = π΅.op_cf_cf_scospan
subsubsectionβΉFunctor from βΉββββΊ is a functorβΊ
lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor:
"β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : ββββ©C β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof-
interpret scospan: cf_scospan Ξ± π π€ π¬ π£ π βΉop_cat ββΊ by (rule cf_scospan_op)
interpret scospan:
is_tm_functor Ξ± βΉββββ©CβΊ βΉop_cat ββΊ βΉβ¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβop_cat βββΊ
by (rule scospan.cf_scospan_the_cf_scospan_is_tm_functor)
show ?thesis by (rule scospan.is_tm_functor_op[unfolded cat_op_simps])
qed
lemma (in cf_sspan) cf_sspan_the_cf_sspan_is_tm_functor':
assumes "π' = ββββ©C" and "β' = β"
shows "β¨πβπ€βπ¬βπ£βπβ©β©Cβ©Fβββ : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β β'"
unfolding assms by (rule cf_sspan_the_cf_sspan_is_tm_functor)
lemmas [cat_ss_cs_intros] = cf_sspan.cf_sspan_the_cf_sspan_is_tm_functor
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Parallel
sectionβΉβΉβββΊ: category with parallel arrows between two objectsβΊ
theory CZH_ECAT_Parallel
imports CZH_ECAT_Small_Functor
begin
subsectionβΉBackgroundβΊ
named_theorems cat_parallel_cs_simps
named_theorems cat_parallel_cs_intros
named_theorems cat_parallel_elem_simps
definition πβ©Pβ©L where [cat_parallel_elem_simps]: "πβ©Pβ©L = 1β©β"
definition πβ©Pβ©L where [cat_parallel_elem_simps]: "πβ©Pβ©L = 2β©β"
definition π€β©Pβ©L where [cat_parallel_elem_simps]: "π€β©Pβ©L = 3β©β"
definition π£β©Pβ©L where [cat_parallel_elem_simps]: "π£β©Pβ©L = 4β©β"
lemma cat_PL_ineq:
shows cat_PL_ππ[cat_parallel_cs_intros]: "πβ©Pβ©L β πβ©Pβ©L"
and cat_PL_ππ€[cat_parallel_cs_intros]: "πβ©Pβ©L β π€β©Pβ©L"
and cat_PL_ππ£[cat_parallel_cs_intros]: "πβ©Pβ©L β π£β©Pβ©L"
and cat_PL_ππ€[cat_parallel_cs_intros]: "πβ©Pβ©L β π€β©Pβ©L"
and cat_PL_ππ£[cat_parallel_cs_intros]: "πβ©Pβ©L β π£β©Pβ©L"
and cat_PL_π€π£[cat_parallel_cs_intros]: "π€β©Pβ©L β π£β©Pβ©L"
unfolding cat_parallel_elem_simps by simp_all
lemma (in π΅)
shows cat_PL_π[cat_parallel_cs_intros]: "πβ©Pβ©L ββ©β Vset Ξ±"
and cat_PL_π[cat_parallel_cs_intros]: "πβ©Pβ©L ββ©β Vset Ξ±"
and cat_PL_π€[cat_parallel_cs_intros]: "π€β©Pβ©L ββ©β Vset Ξ±"
and cat_PL_π£[cat_parallel_cs_intros]: "π£β©Pβ©L ββ©β Vset Ξ±"
unfolding cat_parallel_elem_simps by simp_all
subsectionβΉComposable arrowsβΊ
abbreviation cat_parallel_composable :: "V β V β V β V β V"
where "cat_parallel_composable π π π€ π£ β‘
(set {π} Γβ©β set {π, π€, π£}) βͺβ©β (set {π, π€, π£} Γβ©β set {π})"
textβΉRules.βΊ
lemma cat_parallel_composable_ππ[cat_parallel_cs_intros]:
assumes "g = π" and "f = π"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composable_ππ€[cat_parallel_cs_intros]:
assumes "g = π" and "f = π€"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composable_ππ£[cat_parallel_cs_intros]:
assumes "g = π" and "f = π£"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composable_π€π[cat_parallel_cs_intros]:
assumes "g = π€" and "f = π"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composable_π£π[cat_parallel_cs_intros]:
assumes "g = π£" and "f = π"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composable_ππ[cat_parallel_cs_intros]:
assumes "g = π" and "f = π"
shows "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
unfolding assms by auto
lemma cat_parallel_composableE:
assumes "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
obtains "g = π" and "f = π"
| "g = π" and "f = π€"
| "g = π" and "f = π£"
| "g = π€" and "f = π"
| "g = π£" and "f = π"
| "g = π" and "f = π"
using assms that by auto
textβΉElementary properties.βΊ
lemma cat_parallel_composable_fconverse:
"(cat_parallel_composable π π π€ π£)Β―β©β = cat_parallel_composable π π π£ π€"
by auto
subsectionβΉ
Local assumptions for a category with parallel arrows between two objects
βΊ
locale cat_parallel = π΅ Ξ± for Ξ± +
fixes π π π€ π£
assumes cat_parallel_ππ[cat_parallel_cs_intros]: "π β π"
and cat_parallel_ππ€[cat_parallel_cs_intros]: "π β π€"
and cat_parallel_ππ£[cat_parallel_cs_intros]: "π β π£"
and cat_parallel_ππ€[cat_parallel_cs_intros]: "π β π€"
and cat_parallel_ππ£[cat_parallel_cs_intros]: "π β π£"
and cat_parallel_π€π£[cat_parallel_cs_intros]: "π€ β π£"
and cat_parallel_π_in_Vset[cat_parallel_cs_intros]: "π ββ©β Vset Ξ±"
and cat_parallel_π_in_Vset[cat_parallel_cs_intros]: "π ββ©β Vset Ξ±"
and cat_parallel_π€_in_Vset[cat_parallel_cs_intros]: "π€ ββ©β Vset Ξ±"
and cat_parallel_π£_in_Vset[cat_parallel_cs_intros]: "π£ ββ©β Vset Ξ±"
lemmas (in cat_parallel) cat_parallel_ineq =
cat_parallel_ππ
cat_parallel_ππ€
cat_parallel_ππ£
cat_parallel_ππ€
cat_parallel_ππ£
cat_parallel_π€π£
textβΉRules.βΊ
lemmas (in cat_parallel) [cat_parallel_cs_intros] = cat_parallel_axioms
mk_ide rf cat_parallel_def[unfolded cat_parallel_axioms_def]
|intro cat_parallelI|
|dest cat_parallelD[dest]|
|elim cat_parallelE[elim]|
textβΉDuality.βΊ
lemma (in cat_parallel) cat_parallel_op[cat_op_intros]:
"cat_parallel Ξ± π π π£ π€"
by (intro cat_parallelI)
(auto intro!: cat_parallel_cs_intros cat_parallel_ineq[symmetric])
subsectionβΉβΉβββΊ: category with parallel arrows between two objectsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter I-2 and Chapter III-3 in \cite{mac_lane_categories_2010}.βΊ
definition the_cat_parallel :: "V β V β V β V β V" (βΉβββ©CβΊ)
where "βββ©C π π π€ π£ =
[
set {π, π},
set {π, π, π€, π£},
(Ξ»xββ©βset {π, π, π€, π£}. (x = π ? π : π)),
(Ξ»xββ©βset {π, π, π€, π£}. (x = π ? π : π)),
(
Ξ»gfββ©βcat_parallel_composable π π π€ π£.
if gf = [π, π]β©β β π
| gf = [π, π€]β©β β π€
| gf = [π, π£]β©β β π£
| gf = [π€, π]β©β β π€
| gf = [π£, π]β©β β π£
| otherwise β π
),
vid_on (set {π, π})
]β©β"
textβΉComponents.βΊ
lemma the_cat_parallel_components:
shows "βββ©C π π π€ π£β¦Objβ¦ = set {π, π}"
and "βββ©C π π π€ π£β¦Arrβ¦ = set {π, π, π€, π£}"
and "βββ©C π π π€ π£β¦Domβ¦ = (Ξ»xββ©βset {π, π, π€, π£}. (x = π ? π : π))"
and "βββ©C π π π€ π£β¦Codβ¦ = (Ξ»xββ©βset {π, π, π€, π£}. (x = π ? π : π))"
and "βββ©C π π π€ π£β¦Compβ¦ =
(
Ξ»gfββ©βcat_parallel_composable π π π€ π£.
if gf = [π, π]β©β β π
| gf = [π, π€]β©β β π€
| gf = [π, π£]β©β β π£
| gf = [π€, π]β©β β π€
| gf = [π£, π]β©β β π£
| otherwise β π
)"
and "βββ©C π π π€ π£β¦CIdβ¦ = vid_on (set {π, π})"
unfolding the_cat_parallel_def dg_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObjectsβΊ
lemma the_cat_parallel_Obj_πI[cat_parallel_cs_intros]:
assumes "a = π"
shows "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_Obj_πI[cat_parallel_cs_intros]:
assumes "a = π"
shows "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_ObjE:
assumes "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
obtains "a = π" | "a = π"
using assms unfolding the_cat_parallel_components(1) by fastforce
subsubsectionβΉArrowsβΊ
lemma the_cat_parallel_Arr_πI[cat_parallel_cs_intros]:
assumes "f = π"
shows "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_Arr_πI[cat_parallel_cs_intros]:
assumes "f = π"
shows "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_Arr_π€I[cat_parallel_cs_intros]:
assumes "f = π€"
shows "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_Arr_π£I[cat_parallel_cs_intros]:
assumes "f = π£"
shows "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
using assms unfolding the_cat_parallel_components by simp
lemma the_cat_parallel_ArrE:
assumes "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
obtains "f = π" | "f = π" | "f = π€" | "f = π£"
using assms that unfolding the_cat_parallel_components by auto
subsubsectionβΉDomainβΊ
mk_VLambda the_cat_parallel_components(3)
|vsv the_cat_parallel_Dom_vsv[cat_parallel_cs_intros]|
|vdomain the_cat_parallel_Dom_vdomain[cat_parallel_cs_simps]|
lemma (in cat_parallel) the_cat_parallel_Dom_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms by simp
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π
lemma (in cat_parallel) the_cat_parallel_Dom_app_π€[cat_parallel_cs_simps]:
assumes "f = π€"
shows "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π€
lemma (in cat_parallel) the_cat_parallel_Dom_app_π£[cat_parallel_cs_simps]:
assumes "f = π£"
shows "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π£
lemma (in cat_parallel) the_cat_parallel_Dom_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Dom_app_π
subsubsectionβΉCodomainβΊ
mk_VLambda the_cat_parallel_components(4)
|vsv the_cat_parallel_Cod_vsv[cat_parallel_cs_intros]|
|vdomain the_cat_parallel_Cod_vdomain[cat_parallel_cs_simps]|
lemma (in cat_parallel) the_cat_parallel_Cod_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms by simp
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π
lemma (in cat_parallel) the_cat_parallel_Cod_app_π€[cat_parallel_cs_simps]:
assumes "f = π€"
shows "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π€
lemma (in cat_parallel) the_cat_parallel_Cod_app_π£[cat_parallel_cs_simps]:
assumes "f = π£"
shows "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms using cat_parallel_ineq by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π£
lemma (in cat_parallel) the_cat_parallel_Cod_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
unfolding the_cat_parallel_components assms by auto
lemmas [cat_parallel_cs_simps] = cat_parallel.the_cat_parallel_Cod_app_π
subsubsectionβΉCompositionβΊ
mk_VLambda the_cat_parallel_components(5)
|vsv the_cat_parallel_Comp_vsv[cat_parallel_cs_intros]|
|vdomain the_cat_parallel_Comp_vdomain[cat_parallel_cs_simps]|
|app the_cat_parallel_Comp_app[cat_parallel_cs_simps]|
lemma the_cat_parallel_Comp_app_ππ[cat_parallel_cs_simps]:
assumes "g = π" and "f = π"
shows "g ββ©Aββββ©C π π π€ π£β f = g" "g ββ©Aββββ©C π π π€ π£β f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = g" "g ββ©Aββββ©C π π π€ π£β f = f"
unfolding the_cat_parallel_components(5) assms
by (auto simp: nat_omega_simps)
qed
lemma the_cat_parallel_Comp_app_ππ[cat_parallel_cs_simps]:
assumes "g = π" and "f = π"
shows "g ββ©Aββββ©C π π π€ π£β f = g" "g ββ©Aββββ©C π π π€ π£β f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = g" "g ββ©Aββββ©C π π π€ π£β f = f"
unfolding the_cat_parallel_components(5) assms
by (auto simp: nat_omega_simps)
qed
lemma the_cat_parallel_Comp_app_ππ€[cat_parallel_cs_simps]:
assumes "g = π" and "f = π€"
shows "g ββ©Aββββ©C π π π€ π£β f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = f"
unfolding the_cat_parallel_components(5) assms
by (auto simp: nat_omega_simps)
qed
lemma the_cat_parallel_Comp_app_ππ£[cat_parallel_cs_simps]:
assumes "g = π" and "f = π£"
shows "g ββ©Aββββ©C π π π€ π£β f = f"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = f"
unfolding the_cat_parallel_components(5) assms
by (auto simp: nat_omega_simps)
qed
lemma (in cat_parallel) the_cat_parallel_Comp_app_π€π[cat_parallel_cs_simps]:
assumes "g = π€" and "f = π"
shows "g ββ©Aββββ©C π π π€ π£β f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = g"
unfolding the_cat_parallel_components(5) assms
using cat_parallel_ineq
by (auto simp: nat_omega_simps)
qed
lemma (in cat_parallel) the_cat_parallel_Comp_app_π£π[cat_parallel_cs_simps]:
assumes "g = π£" and "f = π"
shows "g ββ©Aββββ©C π π π€ π£β f = g"
proof-
from assms have "[g, f]β©β ββ©β cat_parallel_composable π π π€ π£"
by (cs_concl cs_intro: cat_parallel_cs_intros)
then show "g ββ©Aββββ©C π π π€ π£β f = g"
unfolding the_cat_parallel_components(5) assms
using cat_parallel_ineq
by (auto simp: nat_omega_simps)
qed
subsubsectionβΉIdentityβΊ
mk_VLambda the_cat_parallel_components(6)[unfolded VLambda_vid_on[symmetric]]
|vsv the_cat_parallel_CId_vsv[cat_parallel_cs_intros]|
|vdomain the_cat_parallel_CId_vdomain[cat_parallel_cs_simps]|
|app the_cat_parallel_CId_app|
lemma the_cat_parallel_CId_app_π[cat_parallel_cs_simps]:
assumes "a = π"
shows "βββ©C π π π€ π£β¦CIdβ¦β¦aβ¦ = π"
unfolding assms by (auto simp: the_cat_parallel_CId_app)
lemma the_cat_parallel_CId_app_π[cat_parallel_cs_simps]:
assumes "a = π"
shows "βββ©C π π π€ π£β¦CIdβ¦β¦aβ¦ = π"
unfolding assms by (auto simp: the_cat_parallel_CId_app)
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma (in cat_parallel) the_cat_parallel_is_arr_πππ[cat_parallel_cs_intros]:
assumes "a' = π" and "b' = π" and "f = π"
shows "f : a' β¦ββββ©C π π π€ π£β b'"
proof(intro is_arrI, unfold assms)
show "βββ©C π π π€ π£β¦Domβ¦β¦πβ¦ = π" "βββ©C π π π€ π£β¦Codβ¦β¦πβ¦ = π"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components)
lemma (in cat_parallel) the_cat_parallel_is_arr_πππ[cat_parallel_cs_intros]:
assumes "a' = π" and "b' = π" and "f = π"
shows "f : a' β¦ββββ©C π π π€ π£β b'"
proof(intro is_arrI, unfold assms)
show "βββ©C π π π€ π£β¦Domβ¦β¦πβ¦ = π" "βββ©C π π π€ π£β¦Codβ¦β¦πβ¦ = π"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components)
lemma (in cat_parallel) the_cat_parallel_is_arr_πππ€[cat_parallel_cs_intros]:
assumes "a' = π" and "b' = π" and "f = π€"
shows "f : a' β¦ββββ©C π π π€ π£β b'"
proof(intro is_arrI, unfold assms(1,2))
from assms(3) show "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π" "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components assms(3))
lemma (in cat_parallel) the_cat_parallel_is_arr_πππ£[cat_parallel_cs_intros]:
assumes "a' = π" and "b' = π" and "f = π£"
shows "f : a' β¦ββββ©C π π π€ π£β b'"
proof(intro is_arrI, unfold assms(1,2))
from assms(3) show "βββ©C π π π€ π£β¦Domβ¦β¦fβ¦ = π" "βββ©C π π π€ π£β¦Codβ¦β¦fβ¦ = π"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)+
qed (auto simp: the_cat_parallel_components assms(3))
lemma (in cat_parallel) the_cat_parallel_is_arrE:
assumes "f' : a' β¦ββββ©C π π π€ π£β b'"
obtains "a' = π" and "b' = π" and "f' = π"
| "a' = π" and "b' = π" and "f' = π"
| "a' = π" and "b' = π" and "f' = π€"
| "a' = π" and "b' = π" and "f' = π£"
proof-
note f = is_arrD[OF assms]
from f(1) consider (π) "f' = π" | (π) "f' = π" | (π€) "f' = π€" | (π£) "f' = π£"
unfolding the_cat_parallel_components(2) by auto
then show ?thesis
proof cases
case π
moreover from f(2)[unfolded π, symmetric] have "a' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
moreover from f(3)[unfolded π, symmetric] have "b' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
ultimately show ?thesis using that by auto
next
case π
moreover from f(2)[unfolded π, symmetric] have "a' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
moreover from f(3)[unfolded π, symmetric] have "b' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
ultimately show ?thesis using that by auto
next
case π€
moreover from f(2)[symmetric] π€ have "a' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
moreover from f(3)[symmetric] π€ have "b' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps)
ultimately show ?thesis using that by auto
next
case π£
moreover from f(2)[symmetric] π£ have "a' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps cs_intro: V_cs_intros)
moreover from f(3)[symmetric] π£ have "b' = π"
by (cs_prems cs_simp: cat_parallel_cs_simps)
ultimately show ?thesis using that by auto
qed
qed
subsubsectionβΉβΉβββΊ is a categoryβΊ
lemma (in cat_parallel) finite_category_the_cat_parallel[cat_parallel_cs_intros]:
"finite_category Ξ± (βββ©C π π π€ π£)"
proof(intro finite_categoryI'' tiny_categoryI'')
show "vfsequence (βββ©C π π π€ π£)" unfolding the_cat_parallel_def by simp
show "vcard (βββ©C π π π€ π£) = 6β©β"
unfolding the_cat_parallel_def by (simp_all add: nat_omega_simps)
show "ββ©β (βββ©C π π π€ π£β¦Domβ¦) ββ©β βββ©C π π π€ π£β¦Objβ¦"
by (auto simp: the_cat_parallel_components)
show "ββ©β (βββ©C π π π€ π£β¦Codβ¦) ββ©β βββ©C π π π€ π£β¦Objβ¦"
by (auto simp: the_cat_parallel_components)
show "(gf ββ©β πβ©β (βββ©C π π π€ π£β¦Compβ¦)) =
(
βg f b c a.
gf = [g, f]β©β β§
g : b β¦ββββ©C π π π€ π£β c β§
f : a β¦ββββ©C π π π€ π£β b
)"
for gf
unfolding the_cat_parallel_Comp_vdomain
proof
assume prems: "gf ββ©β cat_parallel_composable π π π€ π£"
then obtain g f where gf_def: "gf = [g, f]β©β" by auto
from prems show
"βg f b c a.
gf = [g, f]β©β β§
g : b β¦ββββ©C π π π€ π£β c β§
f : a β¦ββββ©C π π π€ π£β b"
unfolding gf_def
by
(
cases rule: cat_parallel_composableE;
(intro exI conjI)?;
cs_concl_step?;
(simp only:)?,
allβΉintro is_arrI, unfold the_cat_parallel_components(2)βΊ
)
(
cs_concl
cs_simp: cat_parallel_cs_simps V_cs_simps cs_intro: V_cs_intros
)+
next
assume
"βg f b' c' a'.
gf = [g, f]β©β β§
g : b' β¦ββββ©C π π π€ π£β c' β§
f : a' β¦ββββ©C π π π€ π£β b'"
then obtain g f b c a
where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦ββββ©C π π π€ π£β c"
and f: "f : a β¦ββββ©C π π π€ π£β b"
by clarsimp
from g f show "gf ββ©β cat_parallel_composable π π π€ π£"
unfolding gf_def
by (elim the_cat_parallel_is_arrE) (auto simp: cat_parallel_cs_intros)
qed
show "πβ©β (βββ©C π π π€ π£β¦CIdβ¦) = βββ©C π π π€ π£β¦Objβ¦"
by (simp add: cat_parallel_cs_simps the_cat_parallel_components)
show "g ββ©Aββββ©C π π π€ π£β f : a β¦ββββ©C π π π€ π£β c"
if "g : b β¦ββββ©C π π π€ π£β c" and "f : a β¦ββββ©C π π π€ π£β b" for b c g a f
using that
by (elim the_cat_parallel_is_arrE; simp only:)
(
allβΉ
solvesβΉsimp add: cat_parallel_ineq cat_parallel_ineq[symmetric]βΊ |
cs_concl cs_simp: cat_parallel_cs_simps
βΊ
)
show
"h ββ©Aββββ©C π π π€ π£β g ββ©Aββββ©C π π π€ π£β f =
h ββ©Aββββ©C π π π€ π£β (g ββ©Aββββ©C π π π€ π£β f)"
if "h : c β¦ββββ©C π π π€ π£β d"
and "g : b β¦ββββ©C π π π€ π£β c"
and "f : a β¦ββββ©C π π π€ π£β b"
for c d h b g a f
using that
by (elim the_cat_parallel_is_arrE; simp only:)
(
allβΉ
solvesβΉsimp only: cat_parallel_ineq cat_parallel_ineq[symmetric]βΊ |
cs_concl
cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
βΊ
)
show "βββ©C π π π€ π£β¦CIdβ¦β¦aβ¦ : a β¦ββββ©C π π π€ π£β a" if "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
for a
proof-
from that consider "a = π" | "a = π"
unfolding the_cat_parallel_components(1) by auto
then show "βββ©C π π π€ π£β¦CIdβ¦β¦aβ¦ : a β¦ββββ©C π π π€ π£β a"
by cases
(
cs_concl
cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros
)+
qed
show "βββ©C π π π€ π£β¦CIdβ¦β¦bβ¦ ββ©Aββββ©C π π π€ π£β f = f"
if "f : a β¦ββββ©C π π π€ π£β b" for a b f
using that
by (elim the_cat_parallel_is_arrE)
(cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
show "f ββ©Aββββ©C π π π€ π£β βββ©C π π π€ π£β¦CIdβ¦β¦bβ¦ = f"
if "f : b β¦ββββ©C π π π€ π£β c" for b c f
using that
by (elim the_cat_parallel_is_arrE)
(cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_parallel_cs_intros)
show "βββ©C π π π€ π£β¦Objβ¦ ββ©β Vset Ξ±"
by
(
cs_concl
cs_simp: the_cat_parallel_components nat_omega_simps
cs_intro: V_cs_intros cat_parallel_cs_intros
)
show "vfinite (βββ©C π π π€ π£β¦Objβ¦)" "vfinite (βββ©C π π π€ π£β¦Arrβ¦)"
unfolding the_cat_parallel_components by auto
qed
(
cs_concl
cs_simp:
nat_omega_simps cat_parallel_cs_simps the_cat_parallel_components(2)
cs_intro:
cat_cs_intros
cat_parallel_cs_intros
V_cs_intros
Limit_succ_in_VsetI
)+
lemmas [cat_parallel_cs_intros] = cat_parallel.finite_category_the_cat_parallel
subsubsectionβΉOpposite parallel categoryβΊ
lemma (in cat_parallel) op_cat_the_cat_parallel[cat_op_simps]:
"op_cat (βββ©C π π π€ π£) = βββ©C π π π£ π€"
proof(rule cat_eqI)
interpret ππ: cat_parallel Ξ± π π π£ π€ by (rule cat_parallel_op)
show ππ: "category Ξ± (βββ©C π π π£ π€)"
by (cs_concl cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
show ππ: "category Ξ± (op_cat (βββ©C π π π€ π£))"
by
(
cs_concl
cs_intro: cat_small_cs_intros cat_op_intros cat_parallel_cs_intros
)
interpret ππ: category Ξ± βΉβββ©C π π π£ π€βΊ by (rule ππ)
interpret ππ: category Ξ± βΉβββ©C π π π€ π£βΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_parallel_cs_intros)
show "op_cat (βββ©C π π π€ π£)β¦Compβ¦ = βββ©C π π π£ π€β¦Compβ¦"
proof(rule vsv_eqI)
show "vsv (op_cat (βββ©C π π π€ π£)β¦Compβ¦)"
unfolding op_cat_components by (rule fflip_vsv)
show "vsv (βββ©C π π π£ π€β¦Compβ¦)"
by (cs_concl cs_intro: cat_parallel_cs_intros)
show [cat_op_simps]:
"πβ©β (op_cat (βββ©C π π π€ π£)β¦Compβ¦) = πβ©β (βββ©C π π π£ π€β¦Compβ¦)"
by
(
cs_concl
cs_simp:
cat_parallel_composable_fconverse
op_cat_components(5)
vdomain_fflip
cat_parallel_cs_simps
cs_intro: cat_cs_intros
)
fix gf assume "gf ββ©β πβ©β (op_cat (βββ©C π π π€ π£)β¦Compβ¦)"
then have "gf ββ©β πβ©β (βββ©C π π π£ π€β¦Compβ¦)" unfolding cat_op_simps by simp
then obtain g f a b c
where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦ββββ©C π π π£ π€β c"
and f: "f : a β¦ββββ©C π π π£ π€β b"
by auto
from g f show "op_cat (βββ©C π π π€ π£)β¦Compβ¦β¦gfβ¦ = βββ©C π π π£ π€β¦Compβ¦β¦gfβ¦"
unfolding gf_def
by (elim ππ.the_cat_parallel_is_arrE)
(
simp add: cat_parallel_cs_intros |
cs_concl
cs_simp: cat_op_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
qed
show "op_cat (βββ©C π π π€ π£)β¦CIdβ¦ = βββ©C π π π£ π€β¦CIdβ¦"
proof(unfold cat_op_simps, rule vsv_eqI, unfold cat_parallel_cs_simps)
fix a assume "a ββ©β set {π, π}"
then consider "a = π" | "a = π" by auto
then show "βββ©C π π π€ π£β¦CIdβ¦β¦aβ¦ = βββ©C π π π£ π€β¦CIdβ¦β¦aβ¦"
by cases (cs_concl cs_simp: cat_parallel_cs_simps)+
qed auto
qed (auto simp: the_cat_parallel_components op_cat_components)
lemmas [cat_op_simps] = cat_parallel.op_cat_the_cat_parallel
subsectionβΉParallel functorβΊ
subsubsectionβΉBackgroundβΊ
textβΉ
The concept of a parallel functor is introduced as a convenient abstraction
for the definition of the equalizers and co-equalizers (e.g., see
Chapter III-3 and Chapter III-4 in \cite{mac_lane_categories_2010}).
βΊ
subsubsectionβΉLocal assumptions for the parallel functorβΊ
locale cf_parallel = cat_parallel Ξ± π π π€ π£ + category Ξ± β
for Ξ± π π π€ π£ π' π' π€' π£' β :: V +
assumes cf_parallel_π€'[cat_parallel_cs_intros]: "π€' : π' β¦βββ π'"
and cf_parallel_π£'[cat_parallel_cs_intros]: "π£' : π' β¦βββ π'"
lemma (in cf_parallel) cf_parallel_π€''[cat_parallel_cs_intros]:
assumes "a = π'" and "b = π'"
shows "π€' : a β¦βββ b"
unfolding assms by (rule cf_parallel_π€')
lemma (in cf_parallel) cf_parallel_π€'''[cat_parallel_cs_intros]:
assumes "g = π€'" and "b = π'"
shows "g : π' β¦βββ b"
unfolding assms by (rule cf_parallel_π€')
lemma (in cf_parallel) cf_parallel_π€''''[cat_parallel_cs_intros]:
assumes "g = π€'" and "a = π'"
shows "g : a β¦βββ π'"
unfolding assms by (rule cf_parallel_π€')
lemma (in cf_parallel) cf_parallel_π£''[cat_parallel_cs_intros]:
assumes "a = π'" and "b = π'"
shows "π£' : a β¦βββ b"
unfolding assms by (rule cf_parallel_π£')
lemma (in cf_parallel) cf_parallel_π£'''[cat_parallel_cs_intros]:
assumes "f = π£'" and "b = π'"
shows "f : π' β¦βββ b"
unfolding assms by (rule cf_parallel_π£')
lemma (in cf_parallel) cf_parallel_π£''''[cat_parallel_cs_intros]:
assumes "f = π£'" and "a = π'"
shows "f : a β¦βββ π'"
unfolding assms by (rule cf_parallel_π£')
textβΉRules.βΊ
lemma (in cf_parallel) cf_parallel_axioms[cat_parallel_cs_intros]:
assumes "Ξ±' = Ξ±"
and "a = π"
and "b = π"
and "g = π€"
and "f = π£"
and "a' = π'"
and "b' = π'"
and "g' = π€'"
and "f' = π£'"
shows "cf_parallel Ξ±' a b g f a' b' g' f' β"
unfolding assms by (rule cf_parallel_axioms)
mk_ide rf cf_parallel_def[unfolded cf_parallel_axioms_def]
|intro cf_parallelI|
|dest cf_parallelD[dest]|
|elim cf_parallelE[elim]|
lemmas [cat_parallel_cs_intros] = cf_parallelD(1,2)
textβΉDuality.βΊ
lemma (in cf_parallel) cf_parallel_op[cat_op_intros]:
"cf_parallel Ξ± π π π£ π€ π' π' π£' π€' (op_cat β)"
by (intro cf_parallelI, unfold cat_op_simps)
(
cs_concl cs_simp: cs_intro:
cat_parallel_cs_intros cat_cs_intros cat_op_intros
)
lemmas [cat_op_intros] = cf_parallel.cf_parallel_op
subsubsectionβΉDefinition and elementary propertiesβΊ
definition the_cf_parallel :: "V β V β V β V β V β V β V β V β V β V"
(βΉββββββΊ)
where "βββββ β π π π€ π£ π' π' π€' π£' =
[
(Ξ»aββ©ββββ©C π π π€ π£β¦Objβ¦. (a = π ? π' : π')),
(
Ξ»fββ©ββββ©C π π π€ π£β¦Arrβ¦.
(
if f = π β ββ¦CIdβ¦β¦π'β¦
| f = π β ββ¦CIdβ¦β¦π'β¦
| f = π€ β π€'
| otherwise β π£'
)
),
βββ©C π π π€ π£,
β
]β©β"
textβΉComponents.βΊ
lemma the_cf_parallel_components:
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦ =
(Ξ»aββ©ββββ©C π π π€ π£β¦Objβ¦. (a = π ? π' : π'))"
and "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦ =
(
Ξ»fββ©ββββ©C π π π€ π£β¦Arrβ¦.
(
if f = π β ββ¦CIdβ¦β¦π'β¦
| f = π β ββ¦CIdβ¦β¦π'β¦
| f = π€ β π€'
| otherwise β π£'
)
)"
and [cat_parallel_cs_simps]:
"βββββ β π π π€ π£ π' π' π€' π£'β¦HomDomβ¦ = βββ©C π π π€ π£"
and [cat_parallel_cs_simps]:
"βββββ β π π π€ π£ π' π' π€' π£'β¦HomCodβ¦ = β"
unfolding the_cf_parallel_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda the_cf_parallel_components(1)
|vsv the_the_cf_parallel_ObjMap_vsv[cat_parallel_cs_intros]|
|vdomain the_cf_parallel_ObjMap_vdomain[cat_parallel_cs_simps]|
|app the_cf_parallel_ObjMap_app|
lemma (in cf_parallel) the_cf_parallel_ObjMap_app_π[cat_parallel_cs_simps]:
assumes "x = π"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦xβ¦ = π'"
by
(
cs_concl
cs_simp:
assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps
cs_intro: cat_parallel_cs_intros
)
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_π
lemma (in cf_parallel) the_cf_parallel_ObjMap_app_π[cat_parallel_cs_simps]:
assumes "x = π"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦xβ¦ = π'"
using cat_parallel_ineq
by
(
cs_concl
cs_simp:
assms the_cf_parallel_ObjMap_app cat_parallel_cs_simps V_cs_simps
cs_intro: cat_parallel_cs_intros
)
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ObjMap_app_π
lemma (in cf_parallel) the_cf_parallel_ObjMap_vrange:
"ββ©β (βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦) ββ©β ββ¦Objβ¦"
unfolding the_cf_parallel_components
proof(intro vrange_VLambda_vsubset)
fix a assume "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
then consider "a = π" | "a = π" unfolding the_cat_parallel_components by auto
then show "(a = π ? π' : π') ββ©β ββ¦Objβ¦"
by (auto intro: cat_cs_intros cat_parallel_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
mk_VLambda the_cf_parallel_components(2)
|vsv the_cf_parallel_ArrMap_vsv[cat_parallel_cs_intros]|
|vdomain the_cf_parallel_ArrMap_vdomain[cat_parallel_cs_simps]|
|app the_cf_parallel_ArrMap_app|
lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π€[cat_parallel_cs_simps]:
assumes "f = π€"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ = π€'"
proof-
from assms have "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
from this show ?thesis
using cat_parallel_ineq
by (elim the_cat_parallel_ArrE; simp only: assms)
(auto simp: the_cf_parallel_ArrMap_app)
qed
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π€
lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π£[cat_parallel_cs_simps]:
assumes "f = π£"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ = π£'"
proof-
from assms have "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
from this show ?thesis
using cat_parallel_ineq
by (elim the_cat_parallel_ArrE; simp only: assms)
(auto simp: the_cf_parallel_ArrMap_app)
qed
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π£
lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦π'β¦"
proof-
from assms have "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
from this show ?thesis
using cat_parallel_ineq
by (elim the_cat_parallel_ArrE; simp only: assms)
(auto simp: the_cf_parallel_ArrMap_app)
qed
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π
lemma (in cf_parallel) the_cf_parallel_ArrMap_app_π[cat_parallel_cs_simps]:
assumes "f = π"
shows "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ = ββ¦CIdβ¦β¦π'β¦"
proof-
from assms have "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
by (cs_concl cs_intro: cat_parallel_cs_intros a_in_succ_xI)
from this show ?thesis
using cat_parallel_ineq
by (elim the_cat_parallel_ArrE; simp only: assms)
(auto simp: the_cf_parallel_ArrMap_app)
qed
lemmas [cat_parallel_cs_simps] = cf_parallel.the_cf_parallel_ArrMap_app_π
lemma (in cf_parallel) the_cf_parallel_ArrMap_vrange:
"ββ©β (βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦) ββ©β ββ¦Arrβ¦"
proof(intro vsv.vsv_vrange_vsubset, unfold cat_parallel_cs_simps)
show "vsv (βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦)"
by (cs_intro_step cat_parallel_cs_intros)
fix f assume "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
then show "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ ββ©β ββ¦Arrβ¦"
by (elim the_cat_parallel_ArrE; simp only:)
(
cs_concl
cs_simp: cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
qed
subsubsectionβΉParallel functor is a functorβΊ
lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor:
"βββββ β π π π€ π£ π' π' π€' π£' : βββ©C π π π€ π£ β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
proof(intro is_functor.cf_is_tm_functor_if_HomDom_finite_category is_functorI')
show "vfsequence (βββββ β π π π€ π£ π' π' π€' π£')"
unfolding the_cf_parallel_def by auto
show "vcard (βββββ β π π π€ π£ π' π' π€' π£') = 4β©β"
unfolding the_cf_parallel_def by (simp add: nat_omega_simps)
show "βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ :
βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦aβ¦ β¦βββ
βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦ββββ©C π π π€ π£β b" for a b f
using that
by (cases rule: the_cat_parallel_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦g ββ©Aββββ©C π π π€ π£β fβ¦ =
βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦gβ¦ ββ©Aβββ
βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦ββββ©C π π π€ π£β c" and "f : a β¦ββββ©C π π π€ π£β b" for b c g a f
using that
by (elim the_cat_parallel_is_arrE)
(
allβΉsimp only:βΊ,
allβΉ
solvesβΉsimp add: cat_parallel_ineq cat_parallel_ineq[symmetric]βΊ |
cs_concl
cs_simp: cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
βΊ
)
show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦βββ©C π π π€ π£β¦CIdβ¦β¦cβ¦β¦ =
ββ¦CIdβ¦β¦βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β βββ©C π π π€ π£β¦Objβ¦" for c
using that
by (elim the_cat_parallel_ObjE; simp only:)
(cs_concl cs_simp: cat_parallel_cs_simps)+
qed
(
cs_concl
cs_simp: cat_parallel_cs_simps
cs_intro:
the_cf_parallel_ObjMap_vrange
cat_parallel_cs_intros
cat_cs_intros
cat_small_cs_intros
)+
lemma (in cf_parallel) cf_parallel_the_cf_parallel_is_tm_functor':
assumes "π' = βββ©C π π π€ π£" and "β' = β"
shows "βββββ β π π π€ π£ π' π' π€' π£' : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β β'"
unfolding assms by (rule cf_parallel_the_cf_parallel_is_tm_functor)
lemmas [cat_parallel_cs_intros] =
cf_parallel.cf_parallel_the_cf_parallel_is_tm_functor'
subsubsectionβΉOpposite parallel functorβΊ
lemma (in cf_parallel) cf_parallel_the_cf_parallel_op[cat_op_simps]:
"op_cf (βββββ β π π π€ π£ π' π' π€' π£') = βββββ (op_cat β) π π π£ π€ π' π' π£' π€'"
proof-
interpret β: is_tm_functor Ξ± βΉβββ©C π π π€ π£βΊ β βΉβββββ β π π π€ π£ π' π' π€' π£'βΊ
by (rule cf_parallel_the_cf_parallel_is_tm_functor)
show ?thesis
proof
(
rule cf_eqI[of Ξ± βΉβββ©C π π π£ π€βΊ βΉop_cat ββΊ _ βΉβββ©C π π π£ π€βΊ βΉop_cat ββΊ],
unfold cat_op_simps
)
show "op_cf (βββββ β π π π€ π£ π' π' π€' π£') : βββ©C π π π£ π€ β¦β¦β©CβΞ±β op_cat β"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
show "βββββ (op_cat β) π π π£ π€ π' π' π£' π€' : βββ©C π π π£ π€ β¦β¦β©CβΞ±β op_cat β"
by
(
cs_concl
cs_intro: cat_op_intros cat_small_cs_intros cat_parallel_cs_intros
)
show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦ =
βββββ (op_cat β) π π π£ π€ π' π' π£' π€'β¦ObjMapβ¦"
proof
(
rule vsv_eqI;
(intro cat_parallel_cs_intros)?;
unfold cat_parallel_cs_simps
)
fix a assume "a ββ©β βββ©C π π π€ π£β¦Objβ¦"
then consider "a = π" | "a = π" by (elim the_cat_parallel_ObjE) simp
then show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ObjMapβ¦β¦aβ¦ =
βββββ (op_cat β) π π π£ π€ π' π' π£' π€'β¦ObjMapβ¦β¦aβ¦"
by cases
(
cs_concl
cs_simp: cat_parallel_cs_simps
cs_intro: cat_parallel_cs_intros cat_op_intros
)
qed (auto simp: the_cat_parallel_components)
show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦ =
βββββ (op_cat β) π π π£ π€ π' π' π£' π€'β¦ArrMapβ¦"
proof
(
rule vsv_eqI;
(intro cat_parallel_cs_intros)?;
unfold cat_parallel_cs_simps
)
fix f assume "f ββ©β βββ©C π π π€ π£β¦Arrβ¦"
then consider "f = π" | "f = π" | "f = π€" | "f = π£"
by (elim the_cat_parallel_ArrE) simp
then show
"βββββ β π π π€ π£ π' π' π€' π£'β¦ArrMapβ¦β¦fβ¦ =
βββββ (op_cat β) π π π£ π€ π' π' π£' π€'β¦ArrMapβ¦β¦fβ¦"
by cases
(
cs_concl
cs_simp: cat_parallel_cs_simps cat_op_simps
cs_intro: cat_parallel_cs_intros cat_op_intros
)+
qed (auto simp: the_cat_parallel_components)
qed simp_all
qed
lemmas [cat_op_simps] = cf_parallel.cf_parallel_the_cf_parallel_op
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Comma
sectionβΉComma categoriesβΊ
theory CZH_ECAT_Comma
imports
CZH_ECAT_NTCF
CZH_ECAT_Simple
begin
subsectionβΉBackgroundβΊ
named_theorems cat_comma_cs_simps
named_theorems cat_comma_cs_intros
subsectionβΉComma categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See Exercise 1.3.vi in \cite{riehl_category_2016} or
Chapter II-6 in \cite{mac_lane_categories_2010}.
βΊ
definition cat_comma_Obj :: "V β V β V"
where "cat_comma_Obj π β β‘ set
{
[a, b, f]β©β | a b f.
a ββ©β πβ¦HomDomβ¦β¦Objβ¦ β§
b ββ©β ββ¦HomDomβ¦β¦Objβ¦ β§
f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπβ¦HomCodβ¦β ββ¦ObjMapβ¦β¦bβ¦
}"
lemma small_cat_comma_Obj[simp]:
"small
{
[a, b, f]β©β | a b f.
a ββ©β πβ¦Objβ¦ β§ b ββ©β π
β¦Objβ¦ β§ f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦
}"
(is βΉsmall ?abfsβΊ)
proof-
define Q where
"Q i = (if i = 0 then πβ¦Objβ¦ else if i = 1β©β then π
β¦Objβ¦ else ββ¦Arrβ¦)"
for i
have "?abfs β elts (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
unfolding Q_def
proof
(
intro subsetI,
unfold mem_Collect_eq,
elim exE conjE,
intro vproductI;
simp only:
)
fix a b f show "πβ©β [a, b, f]β©β = set {0, 1β©β, 2β©β}"
by (simp add: three nat_omega_simps)
qed (force simp: nat_omega_simps)+
then show "small ?abfs" by (rule down)
qed
definition cat_comma_Hom :: "V β V β V β V β V"
where "cat_comma_Hom π β abf a'b'f' β‘ set
{
[abf, a'b'f', [g, h]β©β]β©β | g h.
abf ββ©β cat_comma_Obj π β β§
a'b'f' ββ©β cat_comma_Obj π β β§
g : abfβ¦0β¦ β¦βπβ¦HomDomβ¦β a'b'f'β¦0β¦ β§
h : abfβ¦1β©ββ¦ β¦βββ¦HomDomβ¦β a'b'f'β¦1β©ββ¦ β§
a'b'f'β¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β πβ¦ArrMapβ¦β¦gβ¦ =
ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβπβ¦HomCodβ¦β abfβ¦2β©ββ¦
}"
lemma small_cat_comma_Hom[simp]: "small
{
[abf, a'b'f', [g, h]β©β]β©β | g h.
abf ββ©β cat_comma_Obj π β β§
a'b'f' ββ©β cat_comma_Obj π β β§
g : abfβ¦0β¦ β¦βπβ a'b'f'β¦0β¦ β§
h : abfβ¦1β©ββ¦ β¦βπ
β a'b'f'β¦1β©ββ¦ β§
a'b'f'β¦2β©ββ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ abfβ¦2β©ββ¦
}"
(is βΉsmall ?abf_a'b'f'_ghβΊ)
proof-
define Q where
"Q i =
(
if i = 0
then cat_comma_Obj π β
else if i = 1β©β then cat_comma_Obj π β else πβ¦Arrβ¦ Γβ©β π
β¦Arrβ¦
)"
for i
have "?abf_a'b'f'_gh β elts (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
unfolding Q_def
proof
(
intro subsetI,
unfold mem_Collect_eq,
elim exE conjE,
intro vproductI;
simp only:
)
fix a b f show "πβ©β [a, b, f]β©β = ZFC_in_HOL.set {0, 1β©β, 2β©β}"
by (simp add: three nat_omega_simps)
qed (force simp : nat_omega_simps)+
then show "small ?abf_a'b'f'_gh" by (rule down)
qed
definition cat_comma_Arr :: "V β V β V"
where "cat_comma_Arr π β β‘
(
ββ©βabfββ©βcat_comma_Obj π β. ββ©βa'b'f'ββ©βcat_comma_Obj π β.
cat_comma_Hom π β abf a'b'f'
)"
definition cat_comma_composable :: "V β V β V"
where "cat_comma_composable π β β‘ set
{
[[a'b'f', a''b''f'', g'h']β©β, [abf, a'b'f', gh]β©β]β©β |
abf a'b'f' a''b''f'' g'h' gh.
[a'b'f', a''b''f'', g'h']β©β ββ©β cat_comma_Arr π β β§
[abf, a'b'f', gh]β©β ββ©β cat_comma_Arr π β
}"
lemma small_cat_comma_composable[simp]:
shows "small
{
[[a'b'f', a''b''f'', g'h']β©β, [abf, a'b'f', gh]β©β]β©β |
abf a'b'f' a''b''f'' g'h' gh.
[a'b'f', a''b''f'', g'h']β©β ββ©β cat_comma_Arr π β β§
[abf, a'b'f', gh]β©β ββ©β cat_comma_Arr π β
}"
(is βΉsmall ?SβΊ)
proof(rule down)
show "?S β elts (cat_comma_Arr π β Γβ©β cat_comma_Arr π β)" by auto
qed
definition cat_comma :: "V β V β V" (βΉ(_ β©Cβ©Fββ©Cβ©F _)βΊ [1000, 1000] 999)
where "π β©Cβ©Fββ©Cβ©F β =
[
cat_comma_Obj π β,
cat_comma_Arr π β,
(Ξ»Fββ©βcat_comma_Arr π β. Fβ¦0β¦),
(Ξ»Fββ©βcat_comma_Arr π β. Fβ¦1β©ββ¦),
(
Ξ»GFββ©βcat_comma_composable π β.
[
GFβ¦1β©ββ¦β¦0β¦,
GFβ¦0β¦β¦1β©ββ¦,
[
GFβ¦0β¦β¦2β©ββ¦β¦0β¦ ββ©Aβπβ¦HomDomβ¦β GFβ¦1β©ββ¦β¦2β©ββ¦β¦0β¦,
GFβ¦0β¦β¦2β©ββ¦β¦1β©ββ¦ ββ©Aβββ¦HomDomβ¦β GFβ¦1β©ββ¦β¦2β©ββ¦β¦1β©ββ¦
]β©β
]β©β
),
(
Ξ»abfββ©βcat_comma_Obj π β.
[abf, abf, [πβ¦HomDomβ¦β¦CIdβ¦β¦abfβ¦0β¦β¦, ββ¦HomDomβ¦β¦CIdβ¦β¦abfβ¦1β©ββ¦β¦]β©β]β©β
)
]β©β"
textβΉComponents.βΊ
lemma cat_comma_components:
shows "π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦ = cat_comma_Obj π β"
and "π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦ = cat_comma_Arr π β"
and "π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦ = (Ξ»Fββ©βcat_comma_Arr π β. Fβ¦0β¦)"
and "π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦ = (Ξ»Fββ©βcat_comma_Arr π β. Fβ¦1β©ββ¦)"
and "π β©Cβ©Fββ©Cβ©F ββ¦Compβ¦ =
(
Ξ»GFββ©βcat_comma_composable π β.
[
GFβ¦1β©ββ¦β¦0β¦,
GFβ¦0β¦β¦1β©ββ¦,
[
GFβ¦0β¦β¦2β©ββ¦β¦0β¦ ββ©Aβπβ¦HomDomβ¦β GFβ¦1β©ββ¦β¦2β©ββ¦β¦0β¦,
GFβ¦0β¦β¦2β©ββ¦β¦1β©ββ¦ ββ©Aβββ¦HomDomβ¦β GFβ¦1β©ββ¦β¦2β©ββ¦β¦1β©ββ¦
]β©β
]β©β
)"
and "π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦ =
(
Ξ»abfββ©βcat_comma_Obj π β.
[abf, abf, [πβ¦HomDomβ¦β¦CIdβ¦β¦abfβ¦0β¦β¦, ββ¦HomDomβ¦β¦CIdβ¦β¦abfβ¦1β©ββ¦β¦]β©β]β©β
)"
unfolding cat_comma_def dg_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π
β π β
assumes π: "π : π β¦β¦β©CβΞ±β β"
and β: "β : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π β π by (rule π)
interpretation β: is_functor Ξ± π
β β by (rule β)
lemma cat_comma_Obj_def':
"cat_comma_Obj π β β‘ set
{
[a, b, f]β©β | a b f.
a ββ©β πβ¦Objβ¦ β§ b ββ©β π
β¦Objβ¦ β§ f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦
}"
unfolding cat_comma_Obj_def cat_cs_simps by simp
lemma cat_comma_Hom_def':
"cat_comma_Hom π β abf a'b'f' β‘ set
{
[abf, a'b'f', [g, h]β©β]β©β | g h.
abf ββ©β cat_comma_Obj π β β§
a'b'f' ββ©β cat_comma_Obj π β β§
g : abfβ¦0β¦ β¦βπβ a'b'f'β¦0β¦ β§
h : abfβ¦1β©ββ¦ β¦βπ
β a'b'f'β¦1β©ββ¦ β§
a'b'f'β¦2β©ββ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ abfβ¦2β©ββ¦
}"
unfolding cat_comma_Hom_def cat_cs_simps by simp
lemma cat_comma_components':
shows "π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦ = cat_comma_Obj π β"
and "π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦ = cat_comma_Arr π β"
and "π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦ = (Ξ»Fββ©βcat_comma_Arr π β. Fβ¦0β¦)"
and "π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦ = (Ξ»Fββ©βcat_comma_Arr π β. Fβ¦1β©ββ¦)"
and "π β©Cβ©Fββ©Cβ©F ββ¦Compβ¦ =
(
Ξ»GFββ©βcat_comma_composable π β.
[
GFβ¦1β©ββ¦β¦0β¦,
GFβ¦0β¦β¦1β©ββ¦,
[
GFβ¦0β¦β¦2β©ββ¦β¦0β¦ ββ©Aβπβ GFβ¦1β©ββ¦β¦2β©ββ¦β¦0β¦,
GFβ¦0β¦β¦2β©ββ¦β¦1β©ββ¦ ββ©Aβπ
β GFβ¦1β©ββ¦β¦2β©ββ¦β¦1β©ββ¦
]β©β
]β©β
)"
and "π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦ =
(Ξ»abfββ©βcat_comma_Obj π β. [abf, abf, [πβ¦CIdβ¦β¦abfβ¦0β¦β¦, π
β¦CIdβ¦β¦abfβ¦1β©ββ¦β¦]β©β]β©β)"
unfolding cat_comma_components cat_cs_simps by simp_all
end
subsubsectionβΉObjectsβΊ
lemma cat_comma_ObjI[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "A = [a, b, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
shows "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
using assms(4-6)
unfolding cat_comma_Obj_def'[OF assms(1,2)] assms(3) cat_comma_components
by simp
lemma cat_comma_ObjD[dest]:
assumes "[a, b, f]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
shows "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
using assms
unfolding
cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)]
by auto
lemma cat_comma_ObjE[elim]:
assumes "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
obtains a b f where "A = [a, b, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
using assms
unfolding
cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)]
by auto
subsubsectionβΉArrowsβΊ
lemma cat_comma_HomI[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "F = [abf, a'b'f', [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
shows "F ββ©β cat_comma_Hom π β abf a'b'f'"
using assms(1,2,6-10)
unfolding cat_comma_Hom_def'[OF assms(1,2)] assms(3-5)
by
(
intro in_set_CollectI exI conjI small_cat_comma_Hom,
unfold cat_comma_components'(1,2)[OF assms(1,2), symmetric],
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)+
)
(clarsimp simp: nat_omega_simps)+
lemma cat_comma_HomE[elim]:
assumes "F ββ©β cat_comma_Hom π β abf a'b'f'"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
obtains a b f a' b' f' g h
where "F = [abf, a'b'f', [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
using assms(1)
by
(
unfold
cat_comma_components'[OF assms(2,3)] cat_comma_Hom_def'[OF assms(2,3)],
elim in_small_setE;
(unfold mem_Collect_eq, elim exE conjE cat_comma_ObjE[OF _ assms(2,3)])?,
insert that,
allβΉ
(unfold cat_comma_components'(1,2)[OF assms(2,3), symmetric],
elim cat_comma_ObjE[OF _ assms(2,3)]) | -
βΊ
)
(auto simp: nat_omega_simps)
lemma cat_comma_HomD[dest]:
assumes "[[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β ββ©β cat_comma_Hom π β abf a'b'f'"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
shows "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
using assms(1) by (force elim!: cat_comma_HomE[OF _ assms(2,3)])+
lemma cat_comma_ArrI[cat_comma_cs_intros]:
assumes "F ββ©β cat_comma_Hom π β abf a'b'f'"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
shows "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
using assms
unfolding cat_comma_components cat_comma_Arr_def
by (intro vifunionI)
lemma cat_comma_ArrE[elim]:
assumes "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
obtains abf a'b'f'
where "F ββ©β cat_comma_Hom π β abf a'b'f'"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
using assms unfolding cat_comma_components cat_comma_Arr_def by auto
lemma cat_comma_ArrD[dest]:
assumes "[abf, a'b'f', gh]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
shows "[abf, a'b'f', gh]β©β ββ©β cat_comma_Hom π β abf a'b'f'"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
proof-
from assms obtain abf' a'b'f''
where "[abf, a'b'f', gh]β©β ββ©β cat_comma_Hom π β abf' a'b'f''"
and "abf' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f'' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (elim cat_comma_ArrE)
moreover from cat_comma_HomE[OF this(1) assms(2,3)] have
"abf = abf'" and "a'b'f' = a'b'f''"
by auto
ultimately show "[abf, a'b'f', gh]β©β ββ©β cat_comma_Hom π β abf a'b'f'"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by auto
qed
subsubsectionβΉDomainβΊ
lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦)"
unfolding cat_comma_components by simp
lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦) = π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
unfolding cat_comma_components by simp
lemma cat_comma_Dom_app[cat_comma_cs_simps]:
assumes "F = [abf, a'b'f', gh]β©β" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
shows "π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦β¦Fβ¦ = abf"
using assms(2) unfolding assms(1) cat_comma_components by simp
lemma cat_comma_Dom_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦) ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset)
fix F assume "F ββ©β πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦)"
then have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦" by (cs_prems cs_simp: cat_comma_cs_simps)
then obtain abf a'b'f'
where F: "F ββ©β cat_comma_Hom π β abf a'b'f'"
and abf: "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and a'b'f': "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by auto
from this(1) obtain a b f a' b' f' g h
where "F = [abf, a'b'f', [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by (elim cat_comma_HomE[OF _ assms(1,2)])
from F this abf a'b'f' show "π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦β¦Fβ¦ ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
qed (auto intro: cat_comma_cs_intros)
subsubsectionβΉCodomainβΊ
lemma cat_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦)"
unfolding cat_comma_components by simp
lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦) = π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
unfolding cat_comma_components by simp
lemma cat_comma_Cod_app[cat_comma_cs_simps]:
assumes "F = [abf, a'b'f', gh]β©β" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
shows "π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦β¦Fβ¦ = a'b'f'"
using assms(2)
unfolding assms(1) cat_comma_components
by (simp add: nat_omega_simps)
lemma cat_comma_Cod_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦) ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset)
fix F assume "F ββ©β πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦)"
then have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦" by (cs_prems cs_simp: cat_comma_cs_simps)
then obtain abf a'b'f'
where F: "F ββ©β cat_comma_Hom π β abf a'b'f'"
and abf: "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and a'b'f': "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by auto
from this(1) obtain a b f a' b' f' g h
where "F = [abf, a'b'f', [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by (elim cat_comma_HomE[OF _ assms(1,2)])
from F this abf a'b'f' show "π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦β¦Fβ¦ ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
qed (auto intro: cat_comma_cs_intros)
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma cat_comma_is_arrI[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "F = [abf, a'b'f', gh]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "gh = [g, h]β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
shows "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
proof(intro is_arrI)
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
from assms(7-11) show "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
unfolding assms(3-6)
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
with assms(7-11) show
"π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦β¦Fβ¦ = abf" "π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦β¦Fβ¦ = a'b'f'"
unfolding assms(3-6) by (cs_concl cs_simp: cat_comma_cs_simps)+
qed
lemma cat_comma_is_arrD[dest]:
assumes "[[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β :
[a, b, f]β©β β¦βπ β©Cβ©Fββ©Cβ©F ββ [a', b', f']β©β"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
shows "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
proof-
note F_is_arrD = is_arrD[OF assms(1)]
note F_cat_comma_ArrD = cat_comma_ArrD[OF F_is_arrD(1) assms(2,3)]
show "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+
qed
lemma cat_comma_is_arrE[elim]:
assumes "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
obtains a b f a' b' f' g h
where "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
proof-
note F_is_arrD = is_arrD[OF assms(1)]
from F_is_arrD(1) obtain abf a'b'f'
where "F ββ©β cat_comma_Hom π β abf a'b'f'"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by auto
from this(1) obtain a b f a' b' f' g h
where F_def: "F = [abf, a'b'f', [g, h]β©β]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
and "g : a β¦βπβ a'"
and "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by (elim cat_comma_HomE[OF _ assms(2,3)])
with that show ?thesis
by (metis F_is_arrD(1,2,3) cat_comma_Cod_app cat_comma_Dom_app)
qed
subsubsectionβΉCompositionβΊ
lemma cat_comma_composableI:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "GF = [G, F]β©β"
and "G : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
shows "GF ββ©β cat_comma_composable π β"
proof-
from assms(1,2,5) obtain a b f a' b' f' gh
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, gh]β©β"
and "abf = [a, b, f]β©β"
and "a'b'f' = [a', b', f']β©β"
by auto
with assms(1,2,4) obtain a'' b'' f'' g'h'
where G_def: "G = [[a', b', f']β©β, [a'', b'', f'']β©β, g'h']β©β"
and "a'b'f' = [a', b', f']β©β"
and "a''b''f'' = [a'', b'', f'']β©β"
by auto
from is_arrD(1)[OF assms(4)] have "G ββ©β cat_comma_Arr π β"
unfolding cat_comma_components'(2)[OF assms(1,2)].
moreover from is_arrD(1)[OF assms(5)] have "F ββ©β cat_comma_Arr π β"
unfolding cat_comma_components'(2)[OF assms(1,2)].
ultimately show ?thesis
unfolding assms(3) F_def G_def cat_comma_composable_def
by simp
qed
lemma cat_comma_composableE[elim]:
assumes "GF ββ©β cat_comma_composable π β"
and "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
obtains G F abf a'b'f' a''b''f''
where "GF = [G, F]β©β"
and "G : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
proof-
from assms(1) obtain abf a'b'f' a''b''f'' g'h' gh
where GF_def: "GF = [[a'b'f', a''b''f'', g'h']β©β, [abf, a'b'f', gh]β©β]β©β"
and g'h': "[a'b'f', a''b''f'', g'h']β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
and gh: "[abf, a'b'f', gh]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
unfolding cat_comma_composable_def
by (auto simp: cat_comma_components'[OF assms(2,3)])
note g'h' = cat_comma_ArrD[OF g'h' assms(2,3)]
and gh = cat_comma_ArrD[OF gh assms(2,3)]
from gh(1) assms(2,3) obtain a b f a' b' f' g h
where "[abf, a'b'f', gh]β©β = [abf, a'b'f', [g, h]β©β]β©β"
and abf_def: "abf = [a, b, f]β©β"
and a'b'f'_def: "a'b'f' = [a', b', f']β©β"
and gh_def: "gh = [g, h]β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and [cat_comma_cs_simps]:
"f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
with g'h'(1) assms(2,3) obtain a'' b'' f'' g' h'
where g'h'_def: "[a'b'f', a''b''f'', g'h']β©β = [a'b'f', a''b''f'', [g', h']β©β]β©β"
and a''b''f''_def: "a''b''f'' = [a'', b'', f'']β©β"
and g'h'_def: "g'h' = [g', h']β©β"
and g': "g' : a' β¦βπβ a''"
and h': "h' : b' β¦βπ
β b''"
and f'': "f'' : πβ¦ObjMapβ¦β¦a''β¦ β¦βββ ββ¦ObjMapβ¦β¦b''β¦"
and [cat_comma_cs_simps]:
"f'' ββ©Aβββ πβ¦ArrMapβ¦β¦g'β¦ = ββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'"
by auto
from gh_def have "gh = [g, h]β©β" by simp
from assms(2,3) GF_def g h f f' g' h' f'' have
"[a'b'f', a''b''f'', g'h']β©β : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
moreover from assms(2,3) GF_def g h f f' g' h' f'' have
"[abf, a'b'f', gh]β©β : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
unfolding GF_def gh_def g'h'_def abf_def a'b'f'_def a''b''f''_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI)+
ultimately show ?thesis using that GF_def by auto
qed
lemma cat_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fββ©Cβ©F ββ¦Compβ¦)"
unfolding cat_comma_components by auto
lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Compβ¦) = cat_comma_composable π β"
unfolding cat_comma_components by auto
lemma cat_comma_Comp_app[cat_comma_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "G = [a'b'f', a''b''f'', [g', h']β©β]β©β"
and "F = [abf, a'b'f', [g, h]β©β]β©β"
and "G : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
shows "G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ F = [abf, a''b''f'', [g' ββ©Aβπβ g, h' ββ©Aβπ
β h]β©β]β©β"
using assms(1,2,5,6)
unfolding cat_comma_components'[OF assms(1,2)] assms(3,4)
by
(
cs_concl
cs_simp: omega_of_set V_cs_simps vfsequence_simps
cs_intro: nat_omega_intros V_cs_intros cat_comma_composableI TrueI
)
lemma cat_comma_Comp_is_arr[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "G : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
shows "G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
from assms(1,2,4) obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and abf_def: "abf = [a, b, f]β©β"
and a'b'f'_def: "a'b'f' = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and [symmetric, cat_cs_simps]:
"f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
with assms(1,2,3) obtain a'' b'' f'' g' h'
where G_def: "G = [[a', b', f']β©β, [a'', b'', f'']β©β, [g', h']β©β]β©β"
and a''b''f''_def: "a''b''f'' = [a'', b'', f'']β©β"
and g': "g' : a' β¦βπβ a''"
and h': "h' : b' β¦βπ
β b''"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : πβ¦ObjMapβ¦β¦a''β¦ β¦βββ ββ¦ObjMapβ¦β¦b''β¦"
and [cat_cs_simps]: "f'' ββ©Aβββ πβ¦ArrMapβ¦β¦g'β¦ = ββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'"
by auto
from g' have πg': "πβ¦ArrMapβ¦β¦g'β¦ : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ πβ¦ObjMapβ¦β¦a''β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note [cat_cs_simps] =
category.cat_assoc_helper[
where β=β and h=f'' and g=βΉπβ¦ArrMapβ¦β¦g'β¦βΊ and q=βΉββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'βΊ
]
category.cat_assoc_helper[
where β=β and h=f and g=βΉββ¦ArrMapβ¦β¦hβ¦βΊ and q=βΉf' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦βΊ
]
from assms(1,2,3,4) g h f f' g' h' f'' show ?thesis
unfolding F_def G_def abf_def a'b'f'_def a''b''f''_def
by (intro cat_comma_is_arrI[OF assms(1,2)])
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
)+
qed
subsubsectionβΉIdentityβΊ
lemma cat_comma_CId_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦)"
unfolding cat_comma_components by simp
lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦) = π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
unfolding cat_comma_components'[OF assms(1,2)] by simp
lemma cat_comma_CId_app[cat_comma_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "A = [a, b ,f]β©β"
and "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
shows "π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦Aβ¦ = [A, A, [πβ¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦bβ¦]β©β]β©β"
proof-
from assms(4)[unfolded assms(3), unfolded cat_comma_components'[OF assms(1,2)]]
have "[a, b, f]β©β ββ©β cat_comma_Obj π β".
then show ?thesis
unfolding cat_comma_components'(6)[OF assms(1,2)] assms(3)
by (simp add: nat_omega_simps)
qed
subsubsectionβΉβΉHomβΊ-setβΊ
lemma cat_comma_Hom:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "abf ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
shows "Hom (π β©Cβ©Fββ©Cβ©F β) abf a'b'f' = cat_comma_Hom π β abf a'b'f'"
proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
fix F assume "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
with assms(1,2) show "F ββ©β cat_comma_Hom π β abf a'b'f'"
by (elim cat_comma_is_arrE[OF _ assms(1,2)], intro cat_comma_HomI) force+
next
fix F assume "F ββ©β cat_comma_Hom π β abf a'b'f'"
with assms(1,2) show "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
by (elim cat_comma_HomE[OF _ assms(1,2)], intro cat_comma_is_arrI) force+
qed
subsubsectionβΉComma category is a categoryβΊ
lemma category_cat_comma[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "category Ξ± (π β©Cβ©Fββ©Cβ©F β)"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret π: is_functor Ξ± π
β β by (rule assms(2))
show ?thesis
proof(rule categoryI')
show "vfsequence (π β©Cβ©Fββ©Cβ©F β)" unfolding cat_comma_def by auto
show "vcard (π β©Cβ©Fββ©Cβ©F β) = 6β©β"
unfolding cat_comma_def by (simp add: nat_omega_simps)
show "ββ©β (π β©Cβ©Fββ©Cβ©F ββ¦Domβ¦) ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (rule cat_comma_Dom_vrange[OF assms])
show "ββ©β (π β©Cβ©Fββ©Cβ©F ββ¦Codβ¦) ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (rule cat_comma_Cod_vrange[OF assms])
show "(GF ββ©β πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦Compβ¦)) β·
(βg f b c a. GF = [g, f]β©β β§ g : b β¦βπ β©Cβ©Fββ©Cβ©F ββ c β§ f : a β¦βπ β©Cβ©Fββ©Cβ©F ββ b)"
for GF
proof(intro iffI; (elim exE conjE)?; (simp only: cat_comma_Comp_vdomain)?)
assume prems: "GF ββ©β cat_comma_composable π β"
with assms obtain G F abf a'b'f' a''b''f''
where "GF = [G, F]β©β"
and "G : a'b'f' β¦βπ β©Cβ©Fββ©Cβ©F ββ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
by auto
with assms show "βg f b c a.
GF = [g, f]β©β β§ g : b β¦βπ β©Cβ©Fββ©Cβ©F ββ c β§ f : a β¦βπ β©Cβ©Fββ©Cβ©F ββ b"
by auto
qed (use assms in βΉcs_concl cs_intro: cat_comma_composableIβΊ)
from assms show "πβ©β (π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦) = π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps)
from assms show "g ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ f : a β¦βπ β©Cβ©Fββ©Cβ©F ββ c"
if "g : b β¦βπ β©Cβ©Fββ©Cβ©F ββ c" and "f : a β¦βπ β©Cβ©Fββ©Cβ©F ββ b"
for b c g a f
using that by (cs_concl cs_intro: cat_comma_cs_intros)
from assms show
"H ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ F =
H ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ (G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ F)"
if "H : C β¦βπ β©Cβ©Fββ©Cβ©F ββ D"
and "G : B β¦βπ β©Cβ©Fββ©Cβ©F ββ C"
and "F : A β¦βπ β©Cβ©Fββ©Cβ©F ββ B"
for C D H B G A F
using assms that
proof-
from that(3) assms obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and A_def: "A = [a, b, f]β©β"
and B_def: "B = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and [cat_cs_simps]: "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
with that(2) assms obtain a'' b'' f'' g' h'
where G_def: "G = [[a', b', f']β©β, [a'', b'', f'']β©β, [g', h']β©β]β©β"
and C_def: "C = [a'', b'', f'']β©β"
and g': "g' : a' β¦βπβ a''"
and h': "h' : b' β¦βπ
β b''"
and f'': "f'' : πβ¦ObjMapβ¦β¦a''β¦ β¦βββ ββ¦ObjMapβ¦β¦b''β¦"
and [cat_cs_simps]:
"f'' ββ©Aβββ πβ¦ArrMapβ¦β¦g'β¦ = ββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'"
by auto
with that(1) assms obtain a''' b''' f''' g'' h''
where H_def: "H = [[a'', b'', f'']β©β, [a''', b''', f''']β©β, [g'', h'']β©β]β©β"
and D_def: "D = [a''', b''', f''']β©β"
and g'': "g'' : a'' β¦βπβ a'''"
and h'': "h'' : b'' β¦βπ
β b'''"
and f''': "f''' : πβ¦ObjMapβ¦β¦a'''β¦ β¦βββ ββ¦ObjMapβ¦β¦b'''β¦"
and [cat_cs_simps]:
"f''' ββ©Aβββ πβ¦ArrMapβ¦β¦g''β¦ = ββ¦ArrMapβ¦β¦h''β¦ ββ©Aβββ f''"
by auto
note [cat_cs_simps] =
category.cat_assoc_helper[
where β=β
and h=f''
and g=βΉπβ¦ArrMapβ¦β¦g'β¦βΊ
and q=βΉββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'βΊ
]
category.cat_assoc_helper[
where β=β
and h=f''
and g=βΉπβ¦ArrMapβ¦β¦g'β¦βΊ
and q=βΉββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'βΊ
]
category.cat_assoc_helper[
where β=β
and h=f'''
and g=βΉπβ¦ArrMapβ¦β¦g''β¦βΊ
and q=βΉββ¦ArrMapβ¦β¦h''β¦ ββ©Aβββ f''βΊ
]
from assms that g h f f' g' h' f'' g'' h'' f''' show ?thesis
unfolding F_def G_def H_def A_def B_def C_def D_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show "π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦aβ¦ : a β¦βπ β©Cβ©Fββ©Cβ©F ββ a"
if "a ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" for a
using that
by (elim cat_comma_ObjE[OF _ assms(1)]; (simp only:)?)
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)+
show "π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦bβ¦ ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ f = f"
if "f : a β¦βπ β©Cβ©Fββ©Cβ©F ββ b" for a b f
using that
by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)+
show "f ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦bβ¦ = f"
if "f : b β¦βπ β©Cβ©Fββ©Cβ©F ββ c" for b c f
using that
by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)+
show "π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦ ββ©β Vset Ξ±"
proof(intro vsubsetI, elim cat_comma_ObjE[OF _ assms])
fix F a b f assume prems:
"F = [a, b, f]β©β"
"a ββ©β πβ¦Objβ¦"
"b ββ©β π
β¦Objβ¦"
"f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
from prems(2-4) show "F ββ©β Vset Ξ±"
unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros)
qed
show "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (π β©Cβ©Fββ©Cβ©F β) a b) ββ©β Vset Ξ±"
if "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "B ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
and "A ββ©β Vset Ξ±"
and "B ββ©β Vset Ξ±"
for A B
proof-
define A0 where "A0 = ββ©β (Ξ»Fββ©βA. Fβ¦0β¦)"
define A1 where "A1 = ββ©β (Ξ»Fββ©βA. Fβ¦1β©ββ¦)"
define B0 where "B0 = ββ©β (Ξ»Fββ©βB. Fβ¦0β¦)"
define B1 where "B1 = ββ©β (Ξ»Fββ©βB. Fβ¦1β©ββ¦)"
define A0B0 where "A0B0 = (ββ©βaββ©βA0. ββ©βbββ©βB0. Hom π a b)"
define A1B1 where "A1B1 = (ββ©βaββ©βA1. ββ©βbββ©βB1. Hom π
a b)"
have A0B0: "A0B0 ββ©β Vset Ξ±"
unfolding A0B0_def
proof(rule π.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
show "A0 ββ©β Vset Ξ±"
unfolding A0_def
proof(intro vrange_vprojection_in_VsetI that(3))
fix F assume "F ββ©β A"
with that(1) have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" by auto
with assms obtain a b f where F_def: "F = [a, b, f]β©β" by auto
show "vsv F" unfolding F_def by auto
show "0 ββ©β πβ©β F" unfolding F_def by simp
qed auto
show "B0 ββ©β Vset Ξ±"
unfolding B0_def
proof(intro vrange_vprojection_in_VsetI that(4))
fix F assume "F ββ©β B"
with that(2) have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" by auto
with assms obtain a b f where F_def: "F = [a, b, f]β©β" by auto
show "vsv F" unfolding F_def by auto
show "0 ββ©β πβ©β F" unfolding F_def by simp
qed auto
next
fix a assume "a ββ©β A0"
with that(1) obtain F
where a_def: "a = Fβ¦0β¦" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
unfolding A0_def by force
with assms obtain b f where "F = [a, b, f]β©β" and "a ββ©β πβ¦Objβ¦" by auto
then show "a ββ©β πβ¦Objβ¦" unfolding a_def by simp
next
fix a assume "a ββ©β B0"
with that(2) obtain F
where a_def: "a = Fβ¦0β¦" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
unfolding B0_def by force
with assms obtain b f where "F = [a, b, f]β©β" and "a ββ©β πβ¦Objβ¦" by auto
then show "a ββ©β πβ¦Objβ¦" unfolding a_def by simp
qed
have A1B1: "A1B1 ββ©β Vset Ξ±"
unfolding A1B1_def
proof(rule π.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
show "A1 ββ©β Vset Ξ±"
unfolding A1_def
proof(intro vrange_vprojection_in_VsetI that(3))
fix F assume "F ββ©β A"
with that(1) have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" by auto
with assms obtain a b f where F_def: "F = [a, b, f]β©β" by auto
show "vsv F" unfolding F_def by auto
show "1β©β ββ©β πβ©β F" unfolding F_def by (simp add: nat_omega_simps)
qed auto
show "B1 ββ©β Vset Ξ±"
unfolding B1_def
proof(intro vrange_vprojection_in_VsetI that(4))
fix F assume "F ββ©β B"
with that(2) have "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" by auto
with assms obtain a b f where F_def: "F = [a, b, f]β©β" by auto
show "vsv F" unfolding F_def by auto
show "1β©β ββ©β πβ©β F" unfolding F_def by (simp add: nat_omega_simps)
qed auto
next
fix b assume "b ββ©β A1"
with that(1) obtain F
where b_def: "b = Fβ¦1β©ββ¦" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
unfolding A1_def by force
with assms obtain a f where "F = [a, b, f]β©β" and "b ββ©β π
β¦Objβ¦"
by (auto simp: nat_omega_simps)
then show "b ββ©β π
β¦Objβ¦" unfolding b_def by simp
next
fix b assume "b ββ©β B1"
with that(2) obtain F
where b_def: "b = Fβ¦1β©ββ¦" and "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
unfolding B1_def by force
with assms obtain a f where "F = [a, b, f]β©β" and "b ββ©β π
β¦Objβ¦"
by (auto simp: nat_omega_simps)
then show "b ββ©β π
β¦Objβ¦" unfolding b_def by simp
qed
define Q where
"Q i = (if i = 0 then A else if i = 1β©β then B else (A0B0 Γβ©β A1B1))"
for i
have
"(ββ©βaββ©βA. ββ©βbββ©βB.
Hom (π β©Cβ©Fββ©Cβ©F β) a b) ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof
(
intro vsubsetI,
elim vifunionE,
unfold in_Hom_iff,
intro vproductI ballI
)
fix abf a'b'f' F assume prems:
"abf ββ©β A" "a'b'f' ββ©β B" "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
from prems(3) assms obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and abf_def: "abf = [a, b, f]β©β"
and a'b'f'_def: "a'b'f' = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
have gh: "[g, h]β©β ββ©β A0B0 Γβ©β A1B1"
unfolding A0B0_def A1B1_def
proof
(
intro ftimesI2 vifunionI,
unfold in_Hom_iff A0_def B0_def A1_def B1_def
)
from prems(1) show "a ββ©β ββ©β (Ξ»Fββ©βA. Fβ¦0β¦)"
by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
from prems(2) show "a' ββ©β ββ©β (Ξ»Fββ©βB. Fβ¦0β¦)"
by (intro vsv.vsv_vimageI2'[where a=a'b'f'])
(simp_all add: a'b'f'_def)
from prems(1) show "b ββ©β ββ©β (Ξ»Fββ©βA. Fβ¦1β©ββ¦)"
by (intro vsv.vsv_vimageI2'[where a=abf])
(simp_all add: nat_omega_simps abf_def)
from prems(2) show "b' ββ©β ββ©β (Ξ»Fββ©βB. Fβ¦1β©ββ¦)"
by (intro vsv.vsv_vimageI2'[where a=a'b'f'])
(simp_all add: nat_omega_simps a'b'f'_def)
qed (intro g h)+
show "vsv F" unfolding F_def by auto
show "πβ©β F = set {0, 1β©β, 2β©β}"
by (simp add: F_def three nat_omega_simps)
fix i assume "i ββ©β set {0, 1β©β, 2β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ by auto
from this prems show "Fβ¦iβ¦ ββ©β Q i"
by cases
(simp_all add: F_def Q_def gh abf_def a'b'f'_def nat_omega_simps)
qed
moreover have "(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i) ββ©β Vset Ξ±"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β} ββ©β Vset Ξ±" by (cs_concl cs_intro: V_cs_intros)
from A0B0 A1B1 assms(1,2) that(3,4) show
"Q i ββ©β Vset Ξ±" if "i ββ©β set {0, 1β©β, 2β©β}"
for i
by (simp_all add: Q_def Limit_ftimes_in_VsetI nat_omega_simps)
qed auto
ultimately show "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (π β©Cβ©Fββ©Cβ©F β) a b) ββ©β Vset Ξ±" by auto
qed
qed (auto simp: cat_comma_cs_simps intro: cat_comma_cs_intros)
qed
subsubsectionβΉTiny comma categoryβΊ
lemma tiny_category_cat_comma[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
shows "tiny_category Ξ± (π β©Cβ©Fββ©Cβ©F β)"
proof-
interpret π: is_tm_functor Ξ± π β π by (rule assms(1))
interpret β: is_tm_functor Ξ± π
β β by (rule assms(2))
note π = π.is_functor_axioms
and β = β.is_functor_axioms
interpret category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
show ?thesis
proof(intro tiny_categoryI' category_cat_comma)
have vrange_π: "ββ©β (πβ¦ObjMapβ¦) ββ©β Vset Ξ±"
by (simp add: vrange_in_VsetI π.tm_cf_ObjMap_in_Vset)
moreover have vrange_β: "ββ©β (ββ¦ObjMapβ¦) ββ©β Vset Ξ±"
by (simp add: vrange_in_VsetI β.tm_cf_ObjMap_in_Vset)
ultimately have UU_Hom_in_Vset:
"(ββ©βaββ©βββ©β (πβ¦ObjMapβ¦). ββ©βbββ©βββ©β (ββ¦ObjMapβ¦). Hom β a b) ββ©β Vset Ξ±"
using π.cf_ObjMap_vrange β.cf_ObjMap_vrange
by (auto intro: π.HomCod.cat_Hom_vifunion_in_Vset)
define Q where
"Q i =
(
if i = 0
then πβ¦Objβ¦
else
if i = 1β©β
then π
β¦Objβ¦
else (ββ©βaββ©βββ©β (πβ¦ObjMapβ¦). ββ©βbββ©βββ©β (ββ¦ObjMapβ¦). Hom β a b)
)"
for i
have "π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦ ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vsubsetI)
fix A assume "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
then obtain a b f
where A_def: "A = [a, b, f]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
by (elim cat_comma_ObjE[OF _ π β])
from f have f:
"f ββ©β (ββ©βaββ©βββ©β (πβ¦ObjMapβ¦). ββ©βbββ©βββ©β (ββ¦ObjMapβ¦). Hom β a b)"
by (intro vifunionI, unfold in_Hom_iff)
(
simp_all add:
a b
β.ObjMap.vsv_vimageI2
β.cf_ObjMap_vdomain
π.ObjMap.vsv_vimageI2
π.cf_ObjMap_vdomain
)
show "A ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "πβ©β A = set {0, 1β©β, 2β©β}"
unfolding A_def by (simp add: three nat_omega_simps)
fix i assume "i ββ©β set {0, 1β©β, 2β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ by auto
from this a b f show "Aβ¦iβ¦ ββ©β Q i"
unfolding A_def Q_def by cases (simp_all add: nat_omega_simps)
qed (auto simp: A_def)
qed
moreover have "(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i) ββ©β Vset Ξ±"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β} ββ©β Vset Ξ±"
unfolding three[symmetric] by simp
from this show "Q i ββ©β Vset Ξ±" if "i ββ©β set {0, 1β©β, 2β©β}" for i
using that assms(1,2) UU_Hom_in_Vset
by
(
simp_all add:
Q_def
π.HomDom.tiny_cat_Obj_in_Vset
β.HomDom.tiny_cat_Obj_in_Vset
nat_omega_simps
)
qed auto
ultimately show [simp]: "π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦ ββ©β Vset Ξ±" by auto
define Q where
"Q i =
(
if i = 0
then π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦
else
if i = 1β©β
then π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦
else πβ¦Arrβ¦ Γβ©β π
β¦Arrβ¦
)"
for i
have "π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦ ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vsubsetI)
fix F assume "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
then obtain abf a'b'f' where F: "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'"
by (auto intro: is_arrI)
with assms obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and abf_def: "abf = [a, b, f]β©β"
and a'b'f'_def: "a'b'f' = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
from g h have "[g, h]β©β ββ©β πβ¦Arrβ¦ Γβ©β π
β¦Arrβ¦" by auto
show "F ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "πβ©β F = set {0, 1β©β, 2β©β}"
by (simp add: F_def three nat_omega_simps)
fix i assume "i ββ©β set {0, 1β©β, 2β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ by auto
from this F g h show "Fβ¦iβ¦ ββ©β Q i"
unfolding Q_def F_def abf_def[symmetric] a'b'f'_def[symmetric]
by cases (auto simp: nat_omega_simps)
qed (auto simp: F_def)
qed
moreover have "(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i) ββ©β Vset Ξ±"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β} ββ©β Vset Ξ±"
by (simp add: three[symmetric] nat_omega_simps)
moreover have "πβ¦Arrβ¦ Γβ©β π
β¦Arrβ¦ ββ©β Vset Ξ±"
by
(
auto intro!:
Limit_ftimes_in_VsetI
π.π΅_Ξ² π΅_def
π.HomDom.tiny_cat_Arr_in_Vset
β.HomDom.tiny_cat_Arr_in_Vset
)
ultimately show "Q i ββ©β Vset Ξ±" if "i ββ©β set {0, 1β©β, 2β©β}" for i
using that assms(1,2) UU_Hom_in_Vset
by
(
simp_all add:
Q_def
π.HomDom.tiny_cat_Obj_in_Vset
β.HomDom.tiny_cat_Obj_in_Vset
nat_omega_simps
)
qed auto
ultimately show "π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦ ββ©β Vset Ξ±" by auto
qed (rule π, rule β)
qed
subsectionβΉProjections for a comma categoryβΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
textβΉSee Chapter II-6 in \cite{mac_lane_categories_2010}.βΊ
definition cf_comma_proj_left :: "V β V β V" (βΉ(_ β©Cβ©Fβ¨
_)βΊ [1000, 1000] 999)
where "π β©Cβ©Fβ¨
β =
[
(Ξ»aββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Objβ¦. aβ¦0β¦),
(Ξ»fββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦. fβ¦2β©ββ¦β¦0β¦),
π β©Cβ©Fββ©Cβ©F β,
πβ¦HomDomβ¦
]β©β"
definition cf_comma_proj_right :: "V β V β V" (βΉ(_ β¨
β©Cβ©F _)βΊ [1000, 1000] 999)
where "π β¨
β©Cβ©F β =
[
(Ξ»aββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Objβ¦. aβ¦1β©ββ¦),
(Ξ»fββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦. fβ¦2β©ββ¦β¦1β©ββ¦),
π β©Cβ©Fββ©Cβ©F β,
ββ¦HomDomβ¦
]β©β"
textβΉComponents.βΊ
lemma cf_comma_proj_left_components:
shows "π β©Cβ©Fβ¨
ββ¦ObjMapβ¦ = (Ξ»aββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Objβ¦. aβ¦0β¦)"
and "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦ = (Ξ»fββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦. fβ¦2β©ββ¦β¦0β¦)"
and "π β©Cβ©Fβ¨
ββ¦HomDomβ¦ = π β©Cβ©Fββ©Cβ©F β"
and "π β©Cβ©Fβ¨
ββ¦HomCodβ¦ = πβ¦HomDomβ¦"
unfolding cf_comma_proj_left_def dghm_field_simps
by (simp_all add: nat_omega_simps)
lemma cf_comma_proj_right_components:
shows "π β¨
β©Cβ©F ββ¦ObjMapβ¦ = (Ξ»aββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Objβ¦. aβ¦1β©ββ¦)"
and "π β¨
β©Cβ©F ββ¦ArrMapβ¦ = (Ξ»fββ©βπ β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦. fβ¦2β©ββ¦β¦1β©ββ¦)"
and "π β¨
β©Cβ©F ββ¦HomDomβ¦ = π β©Cβ©Fββ©Cβ©F β"
and "π β¨
β©Cβ©F ββ¦HomCodβ¦ = ββ¦HomDomβ¦"
unfolding cf_comma_proj_right_def dghm_field_simps
by (simp_all add: nat_omega_simps)
context
fixes Ξ± π π
β π β
assumes π: "π : π β¦β¦β©CβΞ±β β"
and β: "β : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π β π by (rule π)
interpretation β: is_functor Ξ± π
β β by (rule β)
lemmas cf_comma_proj_left_components' =
cf_comma_proj_left_components[of π β, unfolded π.cf_HomDom]
lemmas cf_comma_proj_right_components' =
cf_comma_proj_right_components[of π β, unfolded β.cf_HomDom]
lemmas [cat_comma_cs_simps] =
cf_comma_proj_left_components'(3,4)
cf_comma_proj_right_components'(3,4)
end
subsubsectionβΉObject mapβΊ
mk_VLambda cf_comma_proj_left_components(1)
|vsv cf_comma_proj_left_ObjMap_vsv[cat_comma_cs_intros]|
|vdomain cf_comma_proj_left_ObjMap_vdomain[cat_comma_cs_simps]|
mk_VLambda cf_comma_proj_right_components(1)
|vsv cf_comma_proj_right_ObjMap_vsv[cat_comma_cs_intros]|
|vdomain cf_comma_proj_right_ObjMap_vdomain[cat_comma_cs_simps]|
lemma cf_comma_proj_left_ObjMap_app[cat_comma_cs_simps]:
assumes "A = [a, b, f]β©β" and "[a, b, f]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
shows "π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Aβ¦ = a"
using assms(2) unfolding assms(1) cf_comma_proj_left_components by simp
lemma cf_comma_proj_right_ObjMap_app[cat_comma_cs_simps]:
assumes "A = [a, b, f]β©β" and "[a, b, f]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
shows "π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Aβ¦ = b"
using assms(2)
unfolding assms(1) cf_comma_proj_right_components
by (simp add: nat_omega_simps)
lemma cf_comma_proj_left_ObjMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β©Cβ©Fβ¨
ββ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
fix A assume prems: "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
with assms obtain a b f where A_def: "A = [a, b, f]β©β" and a: "a ββ©β πβ¦Objβ¦"
by auto
from assms prems a show "π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Aβ¦ ββ©β πβ¦Objβ¦"
unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)
lemma cf_comma_proj_right_ObjMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β¨
β©Cβ©F ββ¦ObjMapβ¦) ββ©β π
β¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
fix A assume prems: "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦"
with assms obtain a b f where A_def: "A = [a, b, f]β©β" and b: "b ββ©β π
β¦Objβ¦"
by auto
from assms prems b show "π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Aβ¦ ββ©β π
β¦Objβ¦"
unfolding A_def by (cs_concl cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_comma_proj_left_components(2)
|vsv cf_comma_proj_left_ArrMap_vsv[cat_comma_cs_intros]|
|vdomain cf_comma_proj_left_ArrMap_vdomain[cat_comma_cs_simps]|
mk_VLambda cf_comma_proj_right_components(2)
|vsv cf_comma_proj_right_ArrMap_vsv[cat_comma_cs_intros]|
|vdomain cf_comma_proj_right_ArrMap_vdomain[cat_comma_cs_simps]|
lemma cf_comma_proj_left_ArrMap_app[cat_comma_cs_simps]:
assumes "A = [abf, a'b'f', [g, h]β©β]β©β"
and "[abf, a'b'f', [g, h]β©β]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
shows "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Aβ¦ = g"
using assms(2)
unfolding assms(1) cf_comma_proj_left_components
by (simp add: nat_omega_simps)
lemma cf_comma_proj_right_ArrMap_app[cat_comma_cs_simps]:
assumes "A = [abf, a'b'f', [g, h]β©β]β©β"
and "[abf, a'b'f', [g, h]β©β]β©β ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
shows "π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Aβ¦ = h"
using assms(2)
unfolding assms(1) cf_comma_proj_right_components
by (simp add: nat_omega_simps)
lemma cf_comma_proj_left_ArrMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β©Cβ©Fβ¨
ββ¦ArrMapβ¦) ββ©β πβ¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
from assms interpret category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
fix F assume prems: "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
then obtain abf a'b'f' where "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'" by auto
with assms obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and g: "g : a β¦βπβ a'"
by auto
from assms prems g show "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Fβ¦ ββ©β πβ¦Arrβ¦"
unfolding F_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)
lemma cf_comma_proj_right_ArrMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (π β¨
β©Cβ©F ββ¦ArrMapβ¦) ββ©β π
β¦Arrβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
from assms interpret category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
fix F assume prems: "F ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Arrβ¦"
then obtain abf a'b'f' where F: "F : abf β¦βπ β©Cβ©Fββ©Cβ©F ββ a'b'f'" by auto
with assms obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and h: "h : b β¦βπ
β b'"
by auto
from assms prems h show "π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Fβ¦ ββ©β π
β¦Arrβ¦"
unfolding F_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)
subsubsectionβΉProjections for a comma category are functorsβΊ
lemma cf_comma_proj_left_is_functor:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "π β©Cβ©Fβ¨
β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©CβΞ±β π"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
from assms interpret πβ: category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
show ?thesis
proof(rule is_functorI')
show "vfsequence (π β©Cβ©Fβ¨
β)"
unfolding cf_comma_proj_left_def by auto
show "vcard (π β©Cβ©Fβ¨
β) = 4β©β"
unfolding cf_comma_proj_left_def by (simp add: nat_omega_simps)
from assms show "ββ©β (π β©Cβ©Fβ¨
ββ¦ObjMapβ¦) ββ©β πβ¦Objβ¦"
by (rule cf_comma_proj_left_ObjMap_vrange)
show "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Fβ¦ : π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Aβ¦ β¦βπβ π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Bβ¦"
if "F : A β¦βπ β©Cβ©Fββ©Cβ©F ββ B" for A B F
proof-
from assms that obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and A_def: "A = [a, b, f]β©β"
and B_def: "B = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
by auto
from that g show
"π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Fβ¦ : π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Aβ¦ β¦βπβ π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Bβ¦"
unfolding F_def A_def B_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed
show
"π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ Fβ¦ =
π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Gβ¦ ββ©Aβπβ π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦Fβ¦"
if "G : B β¦βπ β©Cβ©Fββ©Cβ©F ββ C" and "F : A β¦βπ β©Cβ©Fββ©Cβ©F ββ B" for B C G A F
proof-
from assms that(2) obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and A_def: "A = [a, b, f]β©β"
and B_def: "B = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and [cat_cs_simps]: "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
with that(1) assms obtain a'' b'' f'' g' h'
where G_def: "G = [[a', b', f']β©β, [a'', b'', f'']β©β, [g', h']β©β]β©β"
and C_def: "C = [a'', b'', f'']β©β"
and g': "g' : a' β¦βπβ a''"
and h': "h' : b' β¦βπ
β b''"
and f'': "f'' : πβ¦ObjMapβ¦β¦a''β¦ β¦βββ ββ¦ObjMapβ¦β¦b''β¦"
and [cat_cs_simps]: "f'' ββ©Aβββ πβ¦ArrMapβ¦β¦g'β¦ = ββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'"
by auto
note [cat_cs_simps] =
category.cat_assoc_helper
[
where β=β
and h=f''
and g=βΉπβ¦ArrMapβ¦β¦g'β¦βΊ
and q=βΉββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'βΊ
]
category.cat_assoc_helper
[
where β=β
and h=f
and g=βΉββ¦ArrMapβ¦β¦hβ¦βΊ
and q=βΉf' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦βΊ
]
from assms that g g' h h' f f' f'' show ?thesis
unfolding F_def G_def A_def B_def C_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
qed
show "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦β¦π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦Aβ¦β¦ = πβ¦CIdβ¦β¦π β©Cβ©Fβ¨
ββ¦ObjMapβ¦β¦Aβ¦β¦"
if "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" for A
proof-
from assms that obtain a b f
where A_def: "A = [a, b, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
by auto
from assms that this(2-4) show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
qed
qed
(
use assms in
βΉ
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
βΊ
)+
qed
lemma cf_comma_proj_left_is_functor'[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "π' = π β©Cβ©Fββ©Cβ©F β"
shows "π β©Cβ©Fβ¨
β : π' β¦β¦β©CβΞ±β π"
using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_functor)
lemma cf_comma_proj_right_is_functor:
assumes "π : π β¦β¦β©CβΞ±β β" and "β : π
β¦β¦β©CβΞ±β β"
shows "π β¨
β©Cβ©F β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©CβΞ±β π
"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
from assms interpret πβ: category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_comma_cs_intros)
show ?thesis
proof(rule is_functorI')
show "vfsequence (π β¨
β©Cβ©F β)"
unfolding cf_comma_proj_right_def by auto
show "vcard (π β¨
β©Cβ©F β) = 4β©β"
unfolding cf_comma_proj_right_def by (simp add: nat_omega_simps)
from assms show "ββ©β (π β¨
β©Cβ©F ββ¦ObjMapβ¦) ββ©β π
β¦Objβ¦"
by (rule cf_comma_proj_right_ObjMap_vrange)
show "π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Fβ¦ : π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Aβ¦ β¦βπ
β π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Bβ¦"
if "F : A β¦βπ β©Cβ©Fββ©Cβ©F ββ B" for A B F
proof-
from assms that obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and A_def: "A = [a, b, f]β©β"
and B_def: "B = [a', b', f']β©β"
and h: "h : b β¦βπ
β b'"
by auto
from that h show
"π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Fβ¦ : π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Aβ¦ β¦βπ
β π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Bβ¦"
unfolding F_def A_def B_def
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed
show
"π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦G ββ©Aβπ β©Cβ©Fββ©Cβ©F ββ Fβ¦ =
π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Gβ¦ ββ©Aβπ
β π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦Fβ¦"
if "G : B β¦βπ β©Cβ©Fββ©Cβ©F ββ C" and "F : A β¦βπ β©Cβ©Fββ©Cβ©F ββ B" for B C G A F
proof-
from assms that(2) obtain a b f a' b' f' g h
where F_def: "F = [[a, b, f]β©β, [a', b', f']β©β, [g, h]β©β]β©β"
and A_def: "A = [a, b, f]β©β"
and B_def: "B = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b β¦βπ
β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βββ ββ¦ObjMapβ¦β¦b'β¦"
and [cat_cs_simps]: "f' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦ = ββ¦ArrMapβ¦β¦hβ¦ ββ©Aβββ f"
by auto
with that(1) assms obtain a'' b'' f'' g' h'
where G_def: "G = [[a', b', f']β©β, [a'', b'', f'']β©β, [g', h']β©β]β©β"
and C_def: "C = [a'', b'', f'']β©β"
and g': "g' : a' β¦βπβ a''"
and h': "h' : b' β¦βπ
β b''"
and f'': "f'' : πβ¦ObjMapβ¦β¦a''β¦ β¦βββ ββ¦ObjMapβ¦β¦b''β¦"
and [cat_cs_simps]: "f'' ββ©Aβββ πβ¦ArrMapβ¦β¦g'β¦ = ββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'"
by auto
note [cat_cs_simps] =
category.cat_assoc_helper
[
where β=β
and h=f''
and g=βΉπβ¦ArrMapβ¦β¦g'β¦βΊ
and q=βΉββ¦ArrMapβ¦β¦h'β¦ ββ©Aβββ f'βΊ
]
category.cat_assoc_helper
[
where β=β
and h=f
and g=βΉββ¦ArrMapβ¦β¦hβ¦βΊ
and q=βΉf' ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦βΊ
]
from assms that g g' h h' f f' f'' show ?thesis
unfolding F_def G_def A_def B_def C_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
qed
show "π β¨
β©Cβ©F ββ¦ArrMapβ¦β¦π β©Cβ©Fββ©Cβ©F ββ¦CIdβ¦β¦Aβ¦β¦ = π
β¦CIdβ¦β¦π β¨
β©Cβ©F ββ¦ObjMapβ¦β¦Aβ¦β¦"
if "A ββ©β π β©Cβ©Fββ©Cβ©F ββ¦Objβ¦" for A
proof-
from assms that obtain a b f
where A_def: "A = [a, b, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ ββ¦ObjMapβ¦β¦bβ¦"
by auto
from assms that this(2-4) show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
qed
qed
(
use assms in
βΉ
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
βΊ
)+
qed
lemma cf_comma_proj_right_is_functor'[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "β : π
β¦β¦β©CβΞ±β β"
and "π' = π β©Cβ©Fββ©Cβ©F β"
shows "π β¨
β©Cβ©F β : π' β¦β¦β©CβΞ±β π
"
using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_functor)
subsubsectionβΉProjections for a tiny comma categoryβΊ
lemma cf_comma_proj_left_is_tm_functor:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
shows "π β©Cβ©Fβ¨
β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
proof(intro is_tm_functorI')
interpret π: is_tm_functor Ξ± π β π by (rule assms(1))
interpret β: is_tm_functor Ξ± π
β β by (rule assms(2))
show Ξ _πβ: "π β©Cβ©Fβ¨
β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
interpret Ξ _πβ: is_functor Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ π βΉπ β©Cβ©Fβ¨
ββΊ
by (rule Ξ _πβ)
interpret πβ: tiny_category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)
show "π β©Cβ©Fβ¨
ββ¦ObjMapβ¦ ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (π β©Cβ©Fβ¨
ββ¦ObjMapβ¦) ββ©β Vset Ξ±"
proof-
note Ξ _πβ.cf_ObjMap_vrange
moreover have "πβ¦Objβ¦ ββ©β Vset Ξ±" by (intro cat_small_cs_intros)
ultimately show ?thesis by auto
qed
qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)
show "π β©Cβ©Fβ¨
ββ¦ArrMapβ¦ ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (π β©Cβ©Fβ¨
ββ¦ArrMapβ¦) ββ©β Vset Ξ±"
proof-
note Ξ _πβ.cf_ArrMap_vrange
moreover have "πβ¦Arrβ¦ ββ©β Vset Ξ±" by (intro cat_small_cs_intros)
ultimately show ?thesis by auto
qed
qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)
qed
lemma cf_comma_proj_left_is_tm_functor'[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "πβ = π β©Cβ©Fββ©Cβ©F β"
shows "π β©Cβ©Fβ¨
β : πβ β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_tm_functor)
lemma cf_comma_proj_right_is_tm_functor:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β" and "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
shows "π β¨
β©Cβ©F β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
proof(intro is_tm_functorI')
interpret π: is_tm_functor Ξ± π β π by (rule assms(1))
interpret β: is_tm_functor Ξ± π
β β by (rule assms(2))
show Ξ _πβ: "π β¨
β©Cβ©F β : π β©Cβ©Fββ©Cβ©F β β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
interpret Ξ _πβ: is_functor Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ π
βΉπ β¨
β©Cβ©F ββΊ
by (rule Ξ _πβ)
interpret πβ: tiny_category Ξ± βΉπ β©Cβ©Fββ©Cβ©F ββΊ
by (cs_concl cs_intro: cat_small_cs_intros cat_comma_cs_intros)
show "π β¨
β©Cβ©F ββ¦ObjMapβ¦ ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (π β¨
β©Cβ©F ββ¦ObjMapβ¦) ββ©β Vset Ξ±"
proof-
note Ξ _πβ.cf_ObjMap_vrange
moreover have "π
β¦Objβ¦ ββ©β Vset Ξ±" by (intro cat_small_cs_intros)
ultimately show ?thesis by auto
qed
qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)
show "π β¨
β©Cβ©F ββ¦ArrMapβ¦ ββ©β Vset Ξ±"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ββ©β (π β¨
β©Cβ©F ββ¦ArrMapβ¦) ββ©β Vset Ξ±"
proof-
note Ξ _πβ.cf_ArrMap_vrange
moreover have "π
β¦Arrβ¦ ββ©β Vset Ξ±" by (intro cat_small_cs_intros)
ultimately show ?thesis by auto
qed
qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)
qed
lemma cf_comma_proj_right_is_tm_functor'[cat_comma_cs_intros]:
assumes "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "β : π
β¦β¦β©Cβ©.β©tβ©mβΞ±β β"
and "πβ = π β©Cβ©Fββ©Cβ©F β"
shows "π β¨
β©Cβ©F β : πβ β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_tm_functor)
subsectionβΉComma categories constructed from a functor and an objectβΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
textβΉSee Chapter II-6 in \cite{mac_lane_categories_2010}.βΊ
definition cat_cf_obj_comma :: "V β V β V" (βΉ(_ β©Cβ©Fβ _)βΊ [1000, 1000] 999)
where "π β©Cβ©Fβ b β‘ π β©Cβ©Fββ©Cβ©F (cf_const (cat_1 0 0) (πβ¦HomCodβ¦) b)"
definition cat_obj_cf_comma :: "V β V β V" (βΉ(_ ββ©Cβ©F _)βΊ [1000, 1000] 999)
where "b ββ©Cβ©F π β‘ (cf_const (cat_1 0 0) (πβ¦HomCodβ¦) b) β©Cβ©Fββ©Cβ©F π"
textβΉAlternative forms of the definitions.βΊ
lemma (in is_functor) cat_cf_obj_comma_def:
"π β©Cβ©Fβ b = π β©Cβ©Fββ©Cβ©F (cf_const (cat_1 0 0) π
b)"
unfolding cat_cf_obj_comma_def cf_HomCod ..
lemma (in is_functor) cat_obj_cf_comma_def:
"b ββ©Cβ©F π = (cf_const (cat_1 0 0) π
b) β©Cβ©Fββ©Cβ©F π"
unfolding cat_obj_cf_comma_def cf_HomCod ..
subsubsectionβΉObjectsβΊ
lemma (in is_functor) cat_cf_obj_comma_ObjI[cat_comma_cs_intros]:
assumes "A = [a, 0, f]β©β" and "a ββ©β πβ¦Objβ¦" and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
shows "A ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
using assms(2,3)
unfolding assms(1)
by
(
cs_concl
cs_simp: cat_cs_simps cat_cf_obj_comma_def
cs_intro: cat_cs_intros vempty_is_zet cat_comma_ObjI
)
lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ObjI
lemma (in is_functor) cat_obj_cf_comma_ObjI[cat_comma_cs_intros]:
assumes "A = [0, a, f]β©β" and "a ββ©β πβ¦Objβ¦" and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
shows "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
using assms(2,3)
unfolding assms(1)
by
(
cs_concl
cs_simp: cat_cs_simps cat_obj_cf_comma_def
cs_intro: vempty_is_zet cat_cs_intros cat_comma_ObjI
)
lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ObjI
lemma (in is_functor) cat_cf_obj_comma_ObjD[dest]:
assumes "[a, b', f]β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
shows "a ββ©β πβ¦Objβ¦"
and "b' = 0"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
proof-
from assms(2) have "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
note obj = cat_comma_ObjD[
OF assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
]
from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
moreover have "cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ = b"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "a ββ©β πβ¦Objβ¦" "b' = 0" "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
using obj by auto
qed
lemmas [dest] = is_functor.cat_cf_obj_comma_ObjD[rotated 1]
lemma (in is_functor) cat_obj_cf_comma_ObjD[dest]:
assumes "[b', a, f]β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
shows "a ββ©β πβ¦Objβ¦"
and "b' = 0"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
proof-
from assms(2) have "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
note obj = cat_comma_ObjD[
OF assms(1)[unfolded cat_obj_cf_comma_def] this is_functor_axioms
]
from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
moreover have "cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ = b"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "a ββ©β πβ¦Objβ¦" "b' = 0" "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
using obj by auto
qed
lemmas [dest] = is_functor.cat_obj_cf_comma_ObjD[rotated 1]
lemma (in is_functor) cat_cf_obj_comma_ObjE[elim]:
assumes "A ββ©β π β©Cβ©Fβ bβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
obtains a f where "A = [a, 0, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
proof-
from assms(2) have "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
obtain a b' f
where "A = [a, b', f]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b': "b' ββ©β cat_1 0 0β¦Objβ¦"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦"
by auto
moreover from b' have [cat_cs_simps]: "b' = 0"
unfolding cat_1_components by auto
moreover have "cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ = b"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show ?thesis using that by auto
qed
lemmas [elim] = is_functor.cat_cf_obj_comma_ObjE[rotated 1]
lemma (in is_functor) cat_obj_cf_comma_ObjE[elim]:
assumes "A ββ©β b ββ©Cβ©F πβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
obtains a f where "A = [0, a, f]β©β"
and "a ββ©β πβ¦Objβ¦"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
proof-
from assms(2) have "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from assms(1)[unfolded cat_obj_cf_comma_def] is_functor_axioms this
obtain a b' f
where A_def: "A = [b', a, f]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b': "b' ββ©β cat_1 0 0β¦Objβ¦"
and f: "f : cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by auto
moreover from b' have [cat_cs_simps]: "b' = 0"
unfolding cat_1_components by auto
moreover have "cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ = b"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show ?thesis using that by auto
qed
lemmas [elim] = is_functor.cat_obj_cf_comma_ObjE[rotated 1]
subsubsectionβΉArrowsβΊ
lemma (in is_functor) cat_cf_obj_comma_ArrI[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "F = [abf, a'b'f', [g, 0]β©β]β©β"
and "abf = [a, 0, f]β©β"
and "a'b'f' = [a', 0, f']β©β"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
shows "F ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
unfolding cat_cf_obj_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
show "π : π β¦β¦β©CβΞ±β π
" by (cs_concl cs_intro: cat_cs_intros)
from assms(1) show const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from vempty_is_zet show 0: "0 : 0 β¦βcat_1 0 0β 0"
by (cs_concl cs_simp: cat_cs_simps cat_1_CId_app cs_intro: cat_cs_intros)
from assms(6) show
"f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦0β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(7) show
"f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦0β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from 0 assms(6) show
"f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = cf_const (cat_1 0 0) π
bβ¦ArrMapβ¦β¦0β¦ ββ©Aβπ
β f"
by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
from const assms(5,6) show
"abf ββ©β π β©Cβ©Fββ©Cβ©F (dghm_const (cat_1 []β©β []β©β) π
b (π
β¦CIdβ¦β¦bβ¦))β¦Objβ¦"
by (fold cat_cf_obj_comma_def)
(cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
from const assms(5,7) show
"a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F (dghm_const (cat_1 []β©β []β©β) π
b (π
β¦CIdβ¦β¦bβ¦))β¦Objβ¦"
by (fold cat_cf_obj_comma_def)
(cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
qed (intro assms)+
lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ArrI
lemma (in is_functor) cat_obj_cf_comma_ArrI[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "F = [abf, a'b'f', [0, g]β©β]β©β"
and "abf = [0, a, f]β©β"
and "a'b'f' = [0, a', f']β©β"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦ "
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
shows "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
unfolding cat_obj_cf_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
show "π : π β¦β¦β©CβΞ±β π
" by (cs_concl cs_intro: cat_cs_intros)
from assms(1) show const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from vempty_is_zet show 0: "0 : 0 β¦βcat_1 0 0β 0"
by (cs_concl cs_simp: cat_1_CId_app cs_intro: cat_cs_intros)
from assms(6) show
"f : cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦0β¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(7) show
"f' : cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦0β¦ β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from 0 assms(7) show
"f' ββ©Aβπ
β cf_const (cat_1 0 0) π
bβ¦ArrMapβ¦β¦0β¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f"
by (cs_concl cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros)
from const assms(5,6) show
"abf ββ©β (dghm_const (cat_1 0 0) π
b (π
β¦CIdβ¦β¦bβ¦)) β©Cβ©Fββ©Cβ©F πβ¦Objβ¦"
by (fold cat_obj_cf_comma_def)
(cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
from const assms(5,7) show
"a'b'f' ββ©β (dghm_const (cat_1 []β©β []β©β) π
b (π
β¦CIdβ¦β¦bβ¦)) β©Cβ©Fββ©Cβ©F πβ¦Objβ¦"
by (fold cat_obj_cf_comma_def)
(cs_concl cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros)
qed (intro assms)+
lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ArrI
lemma (in is_functor) cat_cf_obj_comma_ArrE[elim]:
assumes "F ββ©β π β©Cβ©Fβ bβ¦Arrβ¦" and "b ββ©β π
β¦Objβ¦"
obtains abf a'b'f' a f a' f' g
where "F = [abf, a'b'f', [g, 0]β©β]β©β"
and "abf = [a, 0, f]β©β"
and "a'b'f' = [a', 0, f']β©β"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
and "abf ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
proof-
from cat_comma_ArrE[OF assms(1)[unfolded cat_cf_obj_comma_def]]
obtain abf a'b'f'
where F: "F ββ©β cat_comma_Hom π (cf_const (cat_1 0 0) π
b) abf a'b'f'"
and abf: "abf ββ©β π β©Cβ©Fββ©Cβ©F (cf_const (cat_1 0 0) π
b)β¦Objβ¦"
and a'b'f': "a'b'f' ββ©β π β©Cβ©Fββ©Cβ©F (cf_const (cat_1 0 0) π
b)β¦Objβ¦"
by auto
from assms(2) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from F obtain a b'' f a' b' f' g h
where F_def: "F = [abf, a'b'f', [g, h]β©β]β©β"
and abf_def: "abf = [a, b'', f]β©β"
and a'b'f'_def: "a'b'f' = [a', b', f']β©β"
and g: "g : a β¦βπβ a'"
and h: "h : b'' β¦βcat_1 0 0β b'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b''β¦"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦"
and f_def:
"f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = cf_const (cat_1 0 0) π
bβ¦ArrMapβ¦β¦hβ¦ ββ©Aβπ
β f"
by (elim cat_comma_HomE[OF _ is_functor_axioms const]) blast
note hb'b'' = cat_1_is_arrD[OF h]
from F_def have F_def: "F = [abf, a'b'f', [g, 0]β©β]β©β"
unfolding hb'b'' by simp
from abf_def have abf_def: "abf = [a, 0, f]β©β"
unfolding hb'b'' by simp
from a'b'f'_def have a'b'f'_def: "a'b'f' = [a', 0, f']β©β"
unfolding hb'b'' by simp
from f have f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' have f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f_def f f' g h have f_def: "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from
that F_def abf_def a'b'f'_def g f f' f_def
a'b'f'[folded cat_cf_obj_comma_def] abf[folded cat_cf_obj_comma_def]
show ?thesis
by blast
qed
lemmas [elim] = is_functor.cat_cf_obj_comma_ArrE[rotated 1]
lemma (in is_functor) cat_obj_cf_comma_ArrE[elim]:
assumes "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦" and "b ββ©β π
β¦Objβ¦"
obtains baf b'a'f' a f a' f' g
where "F = [baf, b'a'f', [0, g]β©β]β©β"
and "baf = [0, a, f]β©β"
and "b'a'f' = [0, a', f']β©β"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
and "baf ββ©β b ββ©Cβ©F πβ¦Objβ¦"
and "b'a'f' ββ©β b ββ©Cβ©F πβ¦Objβ¦"
proof-
from cat_comma_ArrE[OF assms(1)[unfolded cat_obj_cf_comma_def]]
obtain baf b'a'f'
where F: "F ββ©β cat_comma_Hom (cf_const (cat_1 0 0) π
b) π baf b'a'f'"
and baf: "baf ββ©β (cf_const (cat_1 0 0) π
b) β©Cβ©Fββ©Cβ©F πβ¦Objβ¦"
and b'a'f': "b'a'f' ββ©β (cf_const (cat_1 0 0) π
b) β©Cβ©Fββ©Cβ©F πβ¦Objβ¦"
by auto
from assms(2) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from F obtain a b'' f a' b' f' h g
where F_def: "F = [baf, b'a'f', [h, g]β©β]β©β"
and baf_def: "baf = [b', a, f]β©β"
and b'a'f'_def: "b'a'f' = [b'', a', f']β©β"
and h: "h : b' β¦βcat_1 0 0β b''"
and g: "g : a β¦βπβ a'"
and f: "f : cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b'β¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and f': "f' : cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦β¦b''β¦ β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and f'_def:
"f' ββ©Aβπ
β cf_const (cat_1 0 0) π
bβ¦ArrMapβ¦β¦hβ¦ = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f"
by (elim cat_comma_HomE[OF _ const is_functor_axioms]) blast
note hb'b'' = cat_1_is_arrD[OF h]
from F_def have F_def: "F = [baf, b'a'f', [0, g]β©β]β©β"
unfolding hb'b'' by simp
from baf_def have baf_def: "baf = [0, a, f]β©β"
unfolding hb'b'' by simp
from b'a'f'_def have b'a'f'_def: "b'a'f' = [0, a', f']β©β"
unfolding hb'b'' by simp
from f have f: "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' have f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f'_def f f' g h have f'_def[symmetric]: "f' = πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f"
unfolding hb'b'' by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from
that F_def baf_def b'a'f'_def g f f' f'_def
baf[folded cat_obj_cf_comma_def] b'a'f'[folded cat_obj_cf_comma_def]
show ?thesis
by blast
qed
lemmas [elim] = is_functor.cat_obj_cf_comma_ArrE
lemma (in is_functor) cat_cf_obj_comma_ArrD[dest]:
assumes "[[a, b', f]β©β, [a', b'', f']β©β, [g, h]β©β]β©β ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "b' = 0"
and "b'' = 0"
and "h = 0"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
and "[a, b', f]β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
and "[a', b'', f']β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
using cat_cf_obj_comma_ArrE[OF assms] by auto
lemmas [dest] = is_functor.cat_cf_obj_comma_ArrD[rotated 1]
lemma (in is_functor) cat_obj_cf_comma_ArrD[dest]:
assumes "[[b', a, f]β©β, [b'', a', f']β©β, [h, g]β©β]β©β ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "b' = 0"
and "b'' = 0"
and "h = 0"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
and "[b', a, f]β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
and "[b'', a', f']β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
using cat_obj_cf_comma_ArrE[OF assms] by auto
lemmas [dest] = is_functor.cat_obj_cf_comma_ArrD
subsubsectionβΉDomainβΊ
lemma cat_cf_obj_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fβ bβ¦Domβ¦)"
unfolding cat_cf_obj_comma_def cat_comma_components by simp
lemma cat_cf_obj_comma_Dom_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fβ bβ¦Domβ¦) = π β©Cβ©Fβ bβ¦Arrβ¦"
unfolding cat_cf_obj_comma_def cat_comma_components by simp
lemma cat_cf_obj_comma_Dom_app[cat_comma_cs_simps]:
assumes "F = [abf, a'b'f', gh]β©β" and "F ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
shows "π β©Cβ©Fβ bβ¦Domβ¦β¦Fβ¦ = abf"
using assms(2)
unfolding assms(1) cat_cf_obj_comma_def cat_comma_components
by simp
lemma (in is_functor) cat_cf_obj_comma_Dom_vrange:
assumes "b ββ©β π
β¦Objβ¦"
shows "ββ©β (π β©Cβ©Fβ bβ¦Domβ¦) ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Dom_vrange[
OF is_functor_axioms const, folded cat_cf_obj_comma_def
]
)
qed
lemma cat_obj_cf_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (b ββ©Cβ©F πβ¦Domβ¦)"
unfolding cat_obj_cf_comma_def cat_comma_components by simp
lemma cat_obj_cf_comma_Dom_vdomain[cat_comma_cs_simps]:
"πβ©β (b ββ©Cβ©F πβ¦Domβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
unfolding cat_obj_cf_comma_def cat_comma_components by simp
lemma cat_obj_cf_comma_Dom_app[cat_comma_cs_simps]:
assumes "F = [baf, b'a'f', gh]β©β" and "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
shows "b ββ©Cβ©F πβ¦Domβ¦β¦Fβ¦ = baf"
using assms(2)
unfolding assms(1) cat_obj_cf_comma_def cat_comma_components
by simp
lemma (in is_functor) cat_obj_cf_comma_Dom_vrange:
assumes "b ββ©β π
β¦Objβ¦"
shows "ββ©β (b ββ©Cβ©F πβ¦Domβ¦) ββ©β b ββ©Cβ©F πβ¦Objβ¦"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Dom_vrange[
OF const is_functor_axioms, folded cat_obj_cf_comma_def
]
)
qed
subsubsectionβΉCodomainβΊ
lemma cat_cf_obj_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fβ bβ¦Codβ¦)"
unfolding cat_cf_obj_comma_def cat_comma_components by simp
lemma cat_cf_obj_comma_Cod_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fβ bβ¦Codβ¦) = π β©Cβ©Fβ bβ¦Arrβ¦"
unfolding cat_cf_obj_comma_def cat_comma_components by simp
lemma cat_cf_obj_comma_Cod_app[cat_comma_cs_simps]:
assumes "F = [abf, a'b'f', gh]β©β" and "F ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
shows "π β©Cβ©Fβ bβ¦Codβ¦β¦Fβ¦ = a'b'f'"
using assms(2)
unfolding assms(1) cat_cf_obj_comma_def cat_comma_components
by (simp add: nat_omega_simps)
lemma (in is_functor) cat_cf_obj_comma_Cod_vrange:
assumes "b ββ©β π
β¦Objβ¦"
shows "ββ©β (π β©Cβ©Fβ bβ¦Codβ¦) ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Cod_vrange[
OF is_functor_axioms const, folded cat_cf_obj_comma_def
]
)
qed
lemma cat_obj_cf_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (b ββ©Cβ©F πβ¦Codβ¦)"
unfolding cat_obj_cf_comma_def cat_comma_components by simp
lemma cat_obj_cf_comma_Cod_vdomain[cat_comma_cs_simps]:
"πβ©β (b ββ©Cβ©F πβ¦Codβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
unfolding cat_obj_cf_comma_def cat_comma_components by simp
lemma cat_obj_cf_comma_Cod_app[cat_comma_cs_simps]:
assumes "F = [baf, b'a'f', gh]β©β" and "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
shows "b ββ©Cβ©F πβ¦Codβ¦β¦Fβ¦ = b'a'f'"
using assms(2)
unfolding assms(1) cat_obj_cf_comma_def cat_comma_components
by (simp add: nat_omega_simps)
lemma (in is_functor) cat_obj_cf_comma_Cod_vrange:
assumes "b ββ©β π
β¦Objβ¦"
shows "ββ©β (b ββ©Cβ©F πβ¦Domβ¦) ββ©β b ββ©Cβ©F πβ¦Objβ¦"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Dom_vrange[
OF const is_functor_axioms, folded cat_obj_cf_comma_def
]
)
qed
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma (in is_functor) cat_cf_obj_comma_is_arrI[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "F = [abf, a'b'f', gh]β©β"
and "abf = [a, 0, f]β©β"
and "a'b'f' = [a', 0, f']β©β"
and "gh = [g, 0]β©β"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
shows "F : abf β¦βπ β©Cβ©Fβ bβ a'b'f'"
proof(intro is_arrI)
from assms(1,6,7,8) show "F ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
with assms(2) show "π β©Cβ©Fβ bβ¦Domβ¦β¦Fβ¦ = abf" "π β©Cβ©Fβ bβ¦Codβ¦β¦Fβ¦ = a'b'f'"
by (cs_concl cs_simp: cat_comma_cs_simps)+
qed
lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_is_arrI
lemma (in is_functor) cat_obj_cf_comma_is_arrI[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "F = [baf, b'a'f', gh]β©β"
and "baf = [0, a, f]β©β"
and "b'a'f' = [0, a', f']β©β"
and "gh = [0, g]β©β"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
shows "F : baf β¦βb ββ©Cβ©F πβ b'a'f'"
proof(intro is_arrI)
from assms(1,6,7,8) show "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros)
with assms(2) show "b ββ©Cβ©F πβ¦Domβ¦β¦Fβ¦ = baf" "b ββ©Cβ©F πβ¦Codβ¦β¦Fβ¦ = b'a'f'"
by (cs_concl cs_simp: cat_comma_cs_simps)+
qed
lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_is_arrI
lemma (in is_functor) cat_cf_obj_comma_is_arrD[dest]:
assumes "[[a, b', f]β©β, [a', b'', f']β©β, [g, h]β©β]β©β :
[a, b', f]β©β β¦βπ β©Cβ©Fβ bβ [a', b'', f']β©β"
and "b ββ©β π
β¦Objβ¦"
shows "b' = []β©β"
and "b'' = []β©β"
and "h = []β©β"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
and "[a, b', f]β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
and "[a', b'', f']β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
by (intro cat_cf_obj_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+
lemma (in is_functor) cat_obj_cf_comma_is_arrD[dest]:
assumes "[[b', a, f]β©β, [b'', a', f']β©β, [h, g]β©β]β©β :
[b', a, f]β©β β¦βb ββ©Cβ©F πβ [b'', a', f']β©β"
and "b ββ©β π
β¦Objβ¦"
shows "b' = 0"
and "b'' = 0"
and "h = 0"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
and "[b', a, f]β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
and "[b'', a', f']β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
by (intro cat_obj_cf_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+
lemmas [dest] = is_functor.cat_obj_cf_comma_is_arrD
lemma (in is_functor) cat_cf_obj_comma_is_arrE[elim]:
assumes "F : abf β¦βπ β©Cβ©Fβ bβ a'b'f'" and "b ββ©β π
β¦Objβ¦"
obtains a f a' f' g
where "F = [[a, 0, f]β©β, [a', 0, f']β©β, [g, 0]β©β]β©β"
and "abf = [a, 0, f]β©β"
and "a'b'f' = [a', 0, f']β©β"
and "g : a β¦βπβ a'"
and "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
and "abf ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
and "a'b'f' ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
proof-
note F = is_arrD[OF assms(1)]
from F(1) obtain abf' a'b'f'' a f a' f' g
where F_def: "F = [abf', a'b'f'', [g, 0]β©β]β©β"
and abf'_def: "abf' = [a, 0, f]β©β"
and a'b'f''_def: "a'b'f'' = [a', 0, f']β©β"
and g: "g : a β¦βπβ a'"
and f: "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β b"
and f': "f' : πβ¦ObjMapβ¦β¦a'β¦ β¦βπ
β b"
and f_def: "f' ββ©Aβπ
β πβ¦ArrMapβ¦β¦gβ¦ = f"
and abf': "abf' ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
and a'b'f'': "a'b'f'' ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
by (elim cat_cf_obj_comma_ArrE[OF _ assms(2)])
from F(2) assms(2) abf'_def a'b'f''_def g f f' f_def have "abf' = abf"
unfolding F_def
by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
from F(3) assms(2) abf'_def a'b'f''_def g f f' f_def have "a'b'f'' = a'b'f'"
unfolding F_def
by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
from that F_def abf'_def a'b'f''_def g f f' f_def abf' a'b'f'' show ?thesis
unfolding βΉabf' = abfβΊ βΉa'b'f'' = a'b'f'βΊ by auto
qed
lemmas [elim] = is_functor.cat_cf_obj_comma_is_arrE
lemma (in is_functor) cat_obj_cf_comma_is_arrE[elim]:
assumes "F : baf β¦βb ββ©Cβ©F πβ b'a'f'"
and "b ββ©β π
β¦Objβ¦"
obtains a f a' f' g
where "F = [[0, a, f]β©β, [0, a', f']β©β, [0, g]β©β]β©β"
and "baf = [0, a, f]β©β"
and "b'a'f' = [0, a', f']β©β"
and "g : a β¦βπβ a'"
and "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
and "baf ββ©β b ββ©Cβ©F πβ¦Objβ¦"
and "b'a'f' ββ©β b ββ©Cβ©F πβ¦Objβ¦"
proof-
note F = is_arrD[OF assms(1)]
from F(1) obtain baf' b'a'f'' a f a' f' g
where F_def: "F = [baf', b'a'f'', [0, g]β©β]β©β"
and baf'_def: "baf' = [0, a, f]β©β"
and b'a'f''_def: "b'a'f'' = [0, a', f']β©β"
and g: "g : a β¦βπβ a'"
and f: "f : b β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
and f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β f = f'"
and baf': "baf' ββ©β b ββ©Cβ©F πβ¦Objβ¦"
and b'a'f'': "b'a'f'' ββ©β b ββ©Cβ©F πβ¦Objβ¦"
by (elim cat_obj_cf_comma_ArrE[OF _ assms(2)])
from F(2) assms(2) baf'_def b'a'f''_def g f f' f'_def have "baf' = baf"
unfolding F_def
by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
from F(3) assms(2) baf'_def b'a'f''_def g f f' f'_def have "b'a'f'' = b'a'f'"
unfolding F_def
by (cs_prems cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros)
from that F_def baf'_def b'a'f''_def g f f' f'_def baf' b'a'f'' show ?thesis
unfolding βΉbaf' = bafβΊ βΉb'a'f'' = b'a'f'βΊ by auto
qed
lemmas [elim] = is_functor.cat_obj_cf_comma_is_arrE
subsubsectionβΉCompositionβΊ
lemma cat_cf_obj_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fβ bβ¦Compβ¦)"
unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
lemma cat_obj_cf_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (b ββ©Cβ©F πβ¦Compβ¦)"
unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
lemma (in is_functor) cat_cf_obj_comma_Comp_app[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦"
and "G = [a'b'f', a''b''f'', [g', h']β©β]β©β"
and "F = [abf, a'b'f', [g, h]β©β]β©β"
and "G : a'b'f' β¦βπ β©Cβ©Fβ bβ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fβ bβ a'b'f'"
shows "G ββ©Aβπ β©Cβ©Fβ bβ F = [abf, a''b''f'', [g' ββ©Aβπβ g, 0]β©β]β©β"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from assms(4) obtain a f a' f' g
where G_def: "G = [[a, 0, f]β©β, [a', 0, f']β©β, [g, 0]β©β]β©β"
by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
from assms(5) obtain a f a' f' g
where F_def: "F = [[a, 0, f]β©β, [a', 0, f']β©β, [g, 0]β©β]β©β"
by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
"h' = 0" "h = 0"
by simp_all
have "h' ββ©Aβcat_1 0 0β h = 0" by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
by
(
rule cat_comma_Comp_app
[
OF
is_functor_axioms
const
assms(2,3)
assms(4)[unfolded cat_cf_obj_comma_def]
assms(5)[unfolded cat_cf_obj_comma_def],
folded cat_cf_obj_comma_def,
unfolded cat_cs_simps
]
)
qed
lemma (in is_functor) cat_obj_cf_comma_Comp_app[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦"
and "G = [b'a'f', b''a''f'', [h', g']β©β]β©β"
and "F = [baf, b'a'f', [h, g]β©β]β©β"
and "G : b'a'f' β¦βb ββ©Cβ©F πβ b''a''f''"
and "F : baf β¦βb ββ©Cβ©F πβ b'a'f'"
shows "G ββ©Aβb ββ©Cβ©F πβ F = [baf, b''a''f'', [0, g' ββ©Aβπβ g]β©β]β©β"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_simp: cs_intro: vempty_is_zet cat_cs_intros)
from assms(4) obtain a f a' f' g
where G_def: "G = [[0, a, f]β©β, [0, a', f']β©β, [0, g]β©β]β©β"
by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
from assms(5) obtain a f a' f' g
where F_def: "F = [[0, a, f]β©β, [0, a', f']β©β, [0, g]β©β]β©β"
by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
from assms(2)[unfolded G_def] assms(3)[unfolded F_def] have [cat_cs_simps]:
"h' = 0" "h = 0"
by simp_all
have "h' ββ©Aβcat_1 0 0β h = 0" by (cs_concl cs_simp: cat_cs_simps) show ?thesis
by
(
rule cat_comma_Comp_app
[
OF
const
is_functor_axioms
assms(2,3)
assms(4)[unfolded cat_obj_cf_comma_def]
assms(5)[unfolded cat_obj_cf_comma_def],
folded cat_obj_cf_comma_def,
unfolded cat_cs_simps
]
)
qed
lemma (in is_functor) cat_cf_obj_comma_Comp_is_arr[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "G : a'b'f' β¦βπ β©Cβ©Fβ bβ a''b''f''"
and "F : abf β¦βπ β©Cβ©Fβ bβ a'b'f'"
shows "G ββ©Aβπ β©Cβ©Fβ bβ F : abf β¦βπ β©Cβ©Fβ bβ a''b''f''"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Comp_is_arr
[
OF
is_functor_axioms
const
assms(2)[unfolded cat_cf_obj_comma_def]
assms(3)[unfolded cat_cf_obj_comma_def],
folded cat_cf_obj_comma_def
]
)
qed
lemma (in is_functor) cat_obj_cf_comma_Comp_is_arr[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
and "G : b'a'f' β¦βb ββ©Cβ©F πβ b''a''f''"
and "F : baf β¦βb ββ©Cβ©F πβ b'a'f'"
shows "G ββ©Aβb ββ©Cβ©F πβ F : baf β¦βb ββ©Cβ©F πβ b''a''f''"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_Comp_is_arr
[
OF
const
is_functor_axioms
assms(2)[unfolded cat_obj_cf_comma_def]
assms(3)[unfolded cat_obj_cf_comma_def],
folded cat_obj_cf_comma_def
]
)
qed
subsubsectionβΉIdentityβΊ
lemma cat_cf_obj_comma_CId_vsv[cat_comma_cs_intros]: "vsv (π β©Cβ©Fβ bβ¦CIdβ¦)"
unfolding cat_cf_obj_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
lemma cat_obj_cf_comma_CId_vsv[cat_comma_cs_intros]: "vsv (b ββ©Cβ©F πβ¦CIdβ¦)"
unfolding cat_obj_cf_comma_def by (cs_concl cs_intro: cat_comma_cs_intros)
lemma (in is_functor) cat_cf_obj_comma_CId_vdomain[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦"
shows "πβ©β (π β©Cβ©Fβ bβ¦CIdβ¦) = π β©Cβ©Fβ bβ¦Objβ¦"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule cat_comma_CId_vdomain[
OF is_functor_axioms const, folded cat_cf_obj_comma_def
]
)
qed
lemma (in is_functor) cat_obj_cf_comma_CId_vdomain[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦"
shows "πβ©β (b ββ©Cβ©F πβ¦CIdβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show "πβ©β (b ββ©Cβ©F πβ¦CIdβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by
(
rule cat_comma_CId_vdomain[
OF const is_functor_axioms, folded cat_obj_cf_comma_def
]
)
qed
lemma (in is_functor) cat_cf_obj_comma_CId_app[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦" and "A = [a, b', f]β©β" and "A ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
shows "π β©Cβ©Fβ bβ¦CIdβ¦β¦Aβ¦ = [A, A, [πβ¦CIdβ¦β¦aβ¦, 0]β©β]β©β"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from assms(3,2) have b'_def: "b' = 0"
by (auto elim: cat_cf_obj_comma_ObjE[OF _ assms(1)])
have [cat_cs_simps]: "cat_1 0 0β¦CIdβ¦β¦b'β¦ = 0"
unfolding cat_1_components b'_def by simp
show ?thesis
by
(
rule cat_comma_CId_app
[
OF
is_functor_axioms
const
assms(2,3)[unfolded cat_cf_obj_comma_def],
unfolded cat_cf_obj_comma_def[symmetric] cat_cs_simps
]
)
qed
lemma (in is_functor) cat_obj_cf_comma_CId_app[cat_comma_cs_simps]:
assumes "b ββ©β π
β¦Objβ¦" and "A = [b', a, f]β©β" and "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
shows "b ββ©Cβ©F πβ¦CIdβ¦β¦Aβ¦ = [A, A, [0, πβ¦CIdβ¦β¦aβ¦]β©β]β©β"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
from assms(3,2) have b'_def: "b' = 0"
by (auto elim: cat_obj_cf_comma_ObjE[OF _ assms(1)])
have [cat_cs_simps]: "cat_1 0 0β¦CIdβ¦β¦b'β¦ = 0"
unfolding cat_1_components b'_def by simp
show ?thesis
by
(
rule cat_comma_CId_app
[
OF
const
is_functor_axioms
assms(2,3)[unfolded cat_obj_cf_comma_def],
unfolded cat_obj_cf_comma_def[symmetric] cat_cs_simps
]
)
qed
subsubsectionβΉ
Comma categories constructed from a functor and an object are categories
βΊ
lemma (in is_functor) category_cat_cf_obj_comma[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
shows "category Ξ± (π β©Cβ©Fβ b)"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule category_cat_comma[
OF is_functor_axioms const, folded cat_cf_obj_comma_def
]
)
qed
lemmas [cat_comma_cs_intros] = is_functor.category_cat_cf_obj_comma
lemma (in is_functor) category_cat_obj_cf_comma[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
shows "category Ξ± (b ββ©Cβ©F π)"
proof-
from assms(1) have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
show ?thesis
by
(
rule category_cat_comma[
OF const is_functor_axioms, folded cat_obj_cf_comma_def
]
)
qed
lemmas [cat_comma_cs_intros] = is_functor.category_cat_obj_cf_comma
subsubsectionβΉTiny comma categories constructed from a functor and an objectβΊ
lemma (in is_tm_functor) tiny_category_cat_cf_obj_comma[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
shows "tiny_category Ξ± (π β©Cβ©Fβ b)"
proof-
from assms(1) have const:
"cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by
(
cs_concl cs_intro:
vempty_is_zet cat_small_cs_intros cat_cs_intros
)
show ?thesis
by
(
rule tiny_category_cat_comma[
OF is_tm_functor_axioms const, folded cat_cf_obj_comma_def
]
)
qed
lemma (in is_tm_functor) tiny_category_cat_obj_cf_comma[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦"
shows "tiny_category Ξ± (b ββ©Cβ©F π)"
proof-
from assms(1) have const:
"cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by
(
cs_concl cs_intro:
vempty_is_zet cat_small_cs_intros cat_cs_intros
)
show ?thesis
by
(
rule tiny_category_cat_comma[
OF const is_tm_functor_axioms, folded cat_obj_cf_comma_def
]
)
qed
subsectionβΉ
Projections for comma categories constructed from a functor and an object
βΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
definition cf_cf_obj_comma_proj :: "V β V β V" (βΉ(_ β©Cβ©Fβ¨
β©O _)βΊ [1000, 1000] 999)
where "π β©Cβ©Fβ¨
β©O b β‘ π β©Cβ©Fβ¨
(cf_const (cat_1 0 0) (πβ¦HomCodβ¦) b)"
definition cf_obj_cf_comma_proj :: "V β V β V" (βΉ(_ β©Oβ¨
β©Cβ©F _)βΊ [1000, 1000] 999)
where "b β©Oβ¨
β©Cβ©F π β‘ (cf_const (cat_1 0 0) (πβ¦HomCodβ¦) b) β¨
β©Cβ©F π"
textβΉAlternative forms of the definitions.βΊ
lemma (in is_functor) cf_cf_obj_comma_proj_def:
"π β©Cβ©Fβ¨
β©O b = π β©Cβ©Fβ¨
(cf_const (cat_1 0 0) π
b)"
unfolding cf_cf_obj_comma_proj_def cf_HomCod..
lemma (in is_functor) cf_obj_cf_comma_proj_def:
"b β©Oβ¨
β©Cβ©F π = (cf_const (cat_1 0 0) π
b) β¨
β©Cβ©F π"
unfolding cf_obj_cf_comma_proj_def cf_HomCod..
textβΉComponents.βΊ
lemma (in is_functor) cf_cf_obj_comma_proj_components[cat_comma_cs_simps]:
shows "π β©Cβ©Fβ¨
β©O bβ¦HomDomβ¦ = π β©Cβ©Fβ b"
and "π β©Cβ©Fβ¨
β©O bβ¦HomCodβ¦ = π"
unfolding
cf_cf_obj_comma_proj_def
cf_comma_proj_left_components
cat_cf_obj_comma_def[symmetric]
cat_cs_simps
by simp_all
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_components
lemma (in is_functor) cf_obj_cf_comma_proj_components[cat_comma_cs_simps]:
shows "b β©Oβ¨
β©Cβ©F πβ¦HomDomβ¦ = b ββ©Cβ©F π"
and "b β©Oβ¨
β©Cβ©F πβ¦HomCodβ¦ = π"
unfolding
cf_obj_cf_comma_proj_def
cf_comma_proj_right_components
cat_obj_cf_comma_def[symmetric]
cat_cs_simps
by simp_all
lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_components
subsubsectionβΉObject mapβΊ
lemma cf_cf_obj_comma_proj_ObjMap_vsv[cat_comma_cs_intros]:
"vsv (π β©Cβ©Fβ¨
β©O bβ¦ObjMapβ¦)"
unfolding cf_cf_obj_comma_proj_def
by (cs_concl cs_intro: cat_comma_cs_intros)
lemma cf_obj_cf_comma_proj_ObjMap_vsv[cat_comma_cs_intros]:
"vsv (b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦)"
unfolding cf_obj_cf_comma_proj_def
by (cs_concl cs_intro: cat_comma_cs_intros)
lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fβ¨
β©O bβ¦ObjMapβ¦) = π β©Cβ©Fβ bβ¦Objβ¦"
unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ObjMap_vdomain
unfolding
cf_cf_obj_comma_proj_def[symmetric]
cf_comma_proj_left_components[symmetric]
cat_comma_cs_simps
by simp
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain
lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]:
"πβ©β (b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ObjMap_vdomain
unfolding
cf_obj_cf_comma_proj_def[symmetric]
cf_comma_proj_right_components[symmetric]
cat_comma_cs_simps
by simp
lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_vdomain
lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_app[cat_comma_cs_simps]:
assumes "A = [a, b', f]β©β" and "[a, b', f]β©β ββ©β π β©Cβ©Fβ bβ¦Objβ¦"
shows "π β©Cβ©Fβ¨
β©O bβ¦ObjMapβ¦β¦Aβ¦ = a"
by
(
rule cf_comma_proj_left_ObjMap_app[
OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def],
folded cf_cf_obj_comma_proj_def
]
)
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_app
lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_app[cat_comma_cs_simps]:
assumes "A = [b', a, f]β©β" and "[b', a, f]β©β ββ©β b ββ©Cβ©F πβ¦Objβ¦"
shows "b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦ = a"
by
(
rule cf_comma_proj_right_ObjMap_app[
OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def],
folded cf_obj_cf_comma_proj_def
]
)
lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemma cf_cf_obj_comma_proj_ArrMap_vsv[cat_comma_cs_intros]:
"vsv (π β©Cβ©Fβ¨
β©O bβ¦ArrMapβ¦)"
unfolding cf_cf_obj_comma_proj_def
by (cs_concl cs_intro: cat_comma_cs_intros)
lemma cf_obj_cf_comma_proj_ArrMap_vsv[cat_comma_cs_intros]:
"vsv (b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦)"
unfolding cf_obj_cf_comma_proj_def
by (cs_concl cs_intro: cat_comma_cs_intros)
lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
"πβ©β (π β©Cβ©Fβ¨
β©O bβ¦ArrMapβ¦) = π β©Cβ©Fβ bβ¦Arrβ¦"
unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ArrMap_vdomain
unfolding
cf_cf_obj_comma_proj_def[symmetric]
cf_comma_proj_left_components[symmetric]
cat_comma_cs_simps
by simp
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain
lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
"πβ©β (b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ArrMap_vdomain
unfolding
cf_obj_cf_comma_proj_def[symmetric]
cf_comma_proj_right_components[symmetric]
cat_comma_cs_simps
by simp
lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_vdomain
lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_app[cat_comma_cs_simps]:
assumes "A = [abf, a'b'f', [g, h]β©β]β©β"
and "[abf, a'b'f', [g, h]β©β]β©β ββ©β π β©Cβ©Fβ bβ¦Arrβ¦"
shows "π β©Cβ©Fβ¨
β©O bβ¦ArrMapβ¦β¦Aβ¦ = g"
by
(
rule cf_comma_proj_left_ArrMap_app[
OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def],
folded cf_cf_obj_comma_proj_def
]
)
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ArrMap_app
lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_app[cat_comma_cs_simps]:
assumes "A = [abf, a'b'f', [g, h]β©β]β©β"
and "[abf, a'b'f', [g, h]β©β]β©β ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
shows "b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦β¦Aβ¦ = h"
by
(
rule cf_comma_proj_right_ArrMap_app[
OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def],
folded cf_obj_cf_comma_proj_def
]
)
lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_app
subsubsectionβΉProjections for a comma category are functorsβΊ
lemma (in is_functor) cf_cf_obj_comma_proj_is_functor:
assumes "b ββ©β π
β¦Objβ¦"
shows "π β©Cβ©Fβ¨
β©O b : π β©Cβ©Fβ b β¦β¦β©CβΞ±β π"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
show ?thesis
by
(
rule cf_comma_proj_left_is_functor[
OF is_functor_axioms const,
folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
]
)
qed
lemma (in is_functor) cf_cf_obj_comma_proj_is_functor'[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦" and "π' = π β©Cβ©Fβ b"
shows "π β©Cβ©Fβ¨
β©O b : π' β¦β¦β©CβΞ±β π"
using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_functor)
lemmas [cat_comma_cs_intros] = is_functor.cf_cf_obj_comma_proj_is_functor'
lemma (in is_functor) cf_obj_cf_comma_proj_is_functor:
assumes "b ββ©β π
β¦Objβ¦"
shows "b β©Oβ¨
β©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β π"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
show ?thesis
by
(
rule cf_comma_proj_right_is_functor[
OF const is_functor_axioms,
folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
]
)
qed
lemma (in is_functor) cf_obj_cf_comma_proj_is_functor'[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦" and "π' = b ββ©Cβ©F π"
shows "b β©Oβ¨
β©Cβ©F π : π' β¦β¦β©CβΞ±β π"
using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_functor)
lemmas [cat_comma_cs_intros] = is_functor.cf_obj_cf_comma_proj_is_functor'
subsubsectionβΉProjections for a tiny comma categoryβΊ
lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor:
assumes "b ββ©β π
β¦Objβ¦"
shows "π β©Cβ©Fβ¨
β©O b : π β©Cβ©Fβ b β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
show ?thesis
by
(
rule cf_comma_proj_left_is_tm_functor[
OF is_tm_functor_axioms const,
folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
]
)
qed
lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦" and "πb = π β©Cβ©Fβ b"
shows "π β©Cβ©Fβ¨
β©O b : πb β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_tm_functor)
lemmas [cat_comma_cs_intros] = is_tm_functor.cf_cf_obj_comma_proj_is_tm_functor'
lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor:
assumes "b ββ©β π
β¦Objβ¦"
shows "b β©Oβ¨
β©Cβ©F π : b ββ©Cβ©F π β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
proof-
from assms have const: "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
show ?thesis
by
(
rule cf_comma_proj_right_is_tm_functor[
OF const is_tm_functor_axioms,
folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
]
)
qed
lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
assumes "b ββ©β π
β¦Objβ¦" and "π' = b ββ©Cβ©F π"
shows "b β©Oβ¨
β©Cβ©F π : π' β¦β¦β©Cβ©.β©tβ©mβΞ±β π"
using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_tm_functor)
lemmas [cat_comma_cs_intros] = is_tm_functor.cf_obj_cf_comma_proj_is_tm_functor'
subsectionβΉComma functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.βΊ
definition cf_cf_arr_comma :: "V β V β V"
(βΉ(_ β©Aββ©Cβ©F _)βΊ [1000, 1000] 999)
where "g β©Aββ©Cβ©F π =
[
(Ξ»Aββ©β(πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F πβ¦Objβ¦. [0, Aβ¦1β©ββ¦, Aβ¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β),
(
Ξ»Fββ©β(πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F πβ¦Arrβ¦.
[
[0, Fβ¦0β¦β¦1β©ββ¦, Fβ¦0β¦β¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β,
[0, Fβ¦1β©ββ¦β¦1β©ββ¦, Fβ¦1β©ββ¦β¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β,
Fβ¦2β©ββ¦
]β©β
),
(πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F π,
(πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦) ββ©Cβ©F π
]β©β"
textβΉComponents.βΊ
lemma cf_cf_arr_comma_components:
shows "g β©Aββ©Cβ©F πβ¦ObjMapβ¦ =
(Ξ»Aββ©β(πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F πβ¦Objβ¦. [0, Aβ¦1β©ββ¦, Aβ¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β)"
and "g β©Aββ©Cβ©F πβ¦ArrMapβ¦ =
(
Ξ»Fββ©β(πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F πβ¦Arrβ¦.
[
[0, Fβ¦0β¦β¦1β©ββ¦, Fβ¦0β¦β¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β,
[0, Fβ¦1β©ββ¦β¦1β©ββ¦, Fβ¦1β©ββ¦β¦2β©ββ¦ ββ©Aβπβ¦HomCodβ¦β g]β©β,
Fβ¦2β©ββ¦
]β©β
)"
and "g β©Aββ©Cβ©F πβ¦HomDomβ¦ = (πβ¦HomCodβ¦β¦Codβ¦β¦gβ¦) ββ©Cβ©F π"
and "g β©Aββ©Cβ©F πβ¦HomCodβ¦ = (πβ¦HomCodβ¦β¦Domβ¦β¦gβ¦) ββ©Cβ©F π"
unfolding cf_cf_arr_comma_def dghm_field_simps
by (simp_all add: nat_omega_simps)
context is_functor
begin
lemma cf_cf_arr_comma_components':
assumes "g : c β¦βπ
β c'"
shows "g β©Aββ©Cβ©F πβ¦ObjMapβ¦ = (Ξ»Aββ©βc' ββ©Cβ©F πβ¦Objβ¦. [0, Aβ¦1β©ββ¦, Aβ¦2β©ββ¦ ββ©Aβπ
β g]β©β)"
and "g β©Aββ©Cβ©F πβ¦ArrMapβ¦ =
(
Ξ»Fββ©βc' ββ©Cβ©F πβ¦Arrβ¦.
[
[0, Fβ¦0β¦β¦1β©ββ¦, Fβ¦0β¦β¦2β©ββ¦ ββ©Aβπ
β g]β©β,
[0, Fβ¦1β©ββ¦β¦1β©ββ¦, Fβ¦1β©ββ¦β¦2β©ββ¦ ββ©Aβπ
β g]β©β,
Fβ¦2β©ββ¦
]β©β
)"
and [cat_comma_cs_simps]: "g β©Aββ©Cβ©F πβ¦HomDomβ¦ = c' ββ©Cβ©F π"
and [cat_comma_cs_simps]: "g β©Aββ©Cβ©F πβ¦HomCodβ¦ = c ββ©Cβ©F π"
using assms
unfolding cf_cf_arr_comma_components
by (simp_all add: cat_cs_simps)
end
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_components'(3,4)
subsubsectionβΉObject mapβΊ
mk_VLambda cf_cf_arr_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
|vsv cf_cf_arr_comma_ObjMap_vsv[cat_comma_cs_intros]|
context is_functor
begin
context
fixes g c c'
assumes g: "g : c β¦βπ
β c'"
begin
mk_VLambda
cf_cf_arr_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
|vdomain cf_cf_arr_comma_ObjMap_vdomain[cat_comma_cs_simps]|
end
end
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_vdomain
lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
assumes "A = [a', b', f']β©β" and "A ββ©β c' ββ©Cβ©F πβ¦Objβ¦" and "g : c β¦βπ
β c'"
shows "g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦ = [a', b', f' ββ©Aβπ
β g]β©β"
proof-
from assms have b': "b' ββ©β πβ¦Objβ¦"
and f: "f' : c' β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
and a'_def: "a' = 0"
by auto
from assms(2) show ?thesis
unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
by (simp add: nat_omega_simps a'_def)
qed
lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange:
assumes "g : c β¦βπ
β c'"
shows "ββ©β (g β©Aββ©Cβ©F πβ¦ObjMapβ¦) ββ©β c ββ©Cβ©F πβ¦Objβ¦"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
)
fix A assume "A ββ©β c' ββ©Cβ©F πβ¦Objβ¦"
with assms is_functor_axioms obtain a f
where A_def: "A = [[]β©β, a, f]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and f: "f : c' β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by auto
from assms a f show "g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦ ββ©β c ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_comma_cs_simps A_def
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed (cs_concl cs_intro: cat_comma_cs_intros)
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_cf_arr_comma_components(2)
|vsv cf_cf_arr_comma_ArrMap_vsv[cat_comma_cs_intros]|
context is_functor
begin
context
fixes g c c'
assumes g: "g : c β¦βπ
β c'"
begin
mk_VLambda
cf_cf_arr_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
|vdomain cf_cf_arr_comma_ArrMap_vdomain[cat_comma_cs_simps]|
end
end
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_vdomain
lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
assumes "A = [[a, b, f]β©β, [a', b', f']β©β, [h, k]β©β]β©β"
and "[[a, b, f]β©β, [a', b', f']β©β, [h, k]β©β]β©β :
[a, b, f]β©β β¦βc' ββ©Cβ©F πβ [a', b', f']β©β"
and "g : c β¦βπ
β c'"
shows "g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦Aβ¦ =
[[a, b, f ββ©Aβπ
β g]β©β, [a', b', f' ββ©Aβπ
β g]β©β, [h, k]β©β]β©β"
proof-
from assms(3) have c': "c' ββ©β π
β¦Objβ¦" by auto
from
cat_obj_cf_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c']
is_arrD(1)[OF assms(2)]
show ?thesis
unfolding assms(1) cf_cf_arr_comma_components'[OF assms(3)]
by (simp_all add: nat_omega_simps)
qed
subsubsectionβΉComma functors are functorsβΊ
lemma (in is_functor) cf_cf_arr_comma_is_functor:
assumes "g : c β¦βπ
β c'"
shows "g β©Aββ©Cβ©F π : c' ββ©Cβ©F π β¦β¦β©CβΞ±β c ββ©Cβ©F π"
proof-
show ?thesis
proof(rule is_functorI')
show "vfsequence (g β©Aββ©Cβ©F π)" unfolding cf_cf_arr_comma_def by simp
from assms show "category Ξ± (c' ββ©Cβ©F π)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from assms show "category Ξ± (c ββ©Cβ©F π)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
show "vcard (g β©Aββ©Cβ©F π) = 4β©β"
unfolding cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
from assms show "ββ©β (g β©Aββ©Cβ©F πβ¦ObjMapβ¦) ββ©β c ββ©Cβ©F πβ¦Objβ¦"
by (intro cf_cf_arr_comma_ObjMap_vrange)
show "g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦Fβ¦ :
g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦ β¦βc ββ©Cβ©F πβ g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Bβ¦"
if "F : A β¦βc' ββ©Cβ©F πβ B" for A B F
proof-
from assms that obtain b f b' f' k
where F_def: "F = [[0, b, f]β©β, [0, b', f']β©β, [0, k]β©β]β©β"
and A_def: "A = [0, b, f]β©β"
and B_def: "B = [0, b', f']β©β"
and k: "k : b β¦βπβ b'"
and f: "f : c' β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and f': "f' : c' β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦kβ¦ ββ©Aβπ
β f = f'"
by auto
from assms that k f f' show ?thesis
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show "g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦G ββ©Aβc' ββ©Cβ©F πβ Fβ¦ =
g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦Gβ¦ ββ©Aβc ββ©Cβ©F πβ g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦Fβ¦"
if "G : B β¦βc' ββ©Cβ©F πβ C" and "F : A β¦βc' ββ©Cβ©F πβ B" for B C G A F
proof-
from that(2) assms obtain b f b' f' k
where F_def: "F = [[0, b, f]β©β, [0, b', f']β©β, [0, k]β©β]β©β"
and A_def: "A = [0, b, f]β©β"
and B_def: "B = [0, b', f']β©β"
and k: "k : b β¦βπβ b'"
and f: "f : c' β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
and f': "f' : c' β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
and f'_def: "πβ¦ArrMapβ¦β¦kβ¦ ββ©Aβπ
β f = f'"
by auto
with that(1) assms obtain b'' f'' k'
where G_def: "G = [[0, b', f']β©β, [0, b'', f'']β©β, [0, k']β©β]β©β"
and C_def: "C = [0, b'', f'']β©β"
and k': "k' : b' β¦βπβ b''"
and f'': "f'' : c' β¦βπ
β πβ¦ObjMapβ¦β¦b''β¦"
and f''_def: "πβ¦ArrMapβ¦β¦k'β¦ ββ©Aβπ
β f' = f''"
by auto
from assms that k f f' f'' k' show ?thesis
unfolding F_def G_def A_def B_def C_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_comma_cs_simps
f''_def[symmetric] f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show "g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦c' ββ©Cβ©F πβ¦CIdβ¦β¦Cβ¦β¦ = c ββ©Cβ©F πβ¦CIdβ¦β¦g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Cβ¦β¦"
if "C ββ©β c' ββ©Cβ©F πβ¦Objβ¦" for C
proof-
from that assms obtain a f
where C_def: "C = [0, a, f]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and f: "f : c' β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by auto
from a assms f show
"g β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦c' ββ©Cβ©F πβ¦CIdβ¦β¦Cβ¦β¦ = c ββ©Cβ©F πβ¦CIdβ¦β¦g β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Cβ¦β¦"
unfolding C_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
qed
(
use assms in
βΉ
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
βΊ
)+
qed
lemma (in is_functor) cf_cf_arr_comma_is_functor'[cat_comma_cs_intros]:
assumes "g : c β¦βπ
β c'" and "π' = c' ββ©Cβ©F π" and "π
' = c ββ©Cβ©F π"
shows "g β©Aββ©Cβ©F π : π' β¦β¦β©CβΞ±β π
'"
using assms(1) unfolding assms(2,3) by (rule cf_cf_arr_comma_is_functor(1))
lemmas [cat_comma_cs_intros] = is_functor.cf_cf_arr_comma_is_functor'
lemma (in is_functor) cf_cf_arr_comma_CId:
assumes "b ββ©β π
β¦Objβ¦"
shows "(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F π = cf_id (b ββ©Cβ©F π)"
proof-
show ?thesis
proof(rule cf_eqI)
from vempty_is_zet assms show "cf_id (b ββ©Cβ©F π) : b ββ©Cβ©F π β¦β¦β©CβΞ±β b ββ©Cβ©F π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from vempty_is_zet assms show "(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β b ββ©Cβ©F π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from assms have ObjMap_dom_lhs:
"πβ©β ((π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
from assms have ObjMap_dom_rhs:
"πβ©β (dghm_id (b ββ©Cβ©F π)β¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ObjMapβ¦ = cf_id (b ββ©Cβ©F π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix A assume prems: "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
with assms obtain a' f'
where A_def: "A = [0, a', f']β©β"
and a': "a' ββ©β πβ¦Objβ¦"
and f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦a'β¦"
by auto
from prems assms vempty_is_zet a' f' show
"(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦ = cf_id (b ββ©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)+
from assms have ArrMap_dom_lhs:
"πβ©β ((π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ArrMapβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
from assms have ArrMap_dom_rhs:
"πβ©β (dghm_id (b ββ©Cβ©F π)β¦ArrMapβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ArrMapβ¦ = cf_id (b ββ©Cβ©F π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix F assume prems: "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
then obtain A B where F: "F : A β¦βb ββ©Cβ©F πβ B" by (auto dest: is_arrI)
from assms F obtain b' f' b'' f'' h
where F_def: "F = [[0, b', f']β©β, [0, b'', f'']β©β, [0, h]β©β]β©β"
and A_def: "A = [0, b', f']β©β"
and B_def: "B = [0, b'', f'']β©β"
and h: "h : b' β¦βπβ b''"
and f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : b β¦βπ
β πβ¦ObjMapβ¦β¦b''β¦"
and "πβ¦ArrMapβ¦β¦hβ¦ ββ©Aβπ
β f' = f''"
by auto
from assms prems F h f' f'' show
"(π
β¦CIdβ¦β¦bβ¦) β©Aββ©Cβ©F πβ¦ArrMapβ¦β¦Fβ¦ = cf_id (b ββ©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_comma_cs_intros cat_cs_intros)+
qed simp_all
qed
subsubsectionβΉComma functors and projectionsβΊ
lemma (in is_functor)
cf_cf_comp_cf_obj_cf_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]:
assumes "f : a β¦βπ
β b"
shows "a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π = b β©Oβ¨
β©Cβ©F π"
proof-
show ?thesis
proof(rule cf_eqI)
from assms vempty_is_zet show "b β©Oβ¨
β©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from assms show
"a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π : b ββ©Cβ©F π β¦β¦β©CβΞ±β π"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from assms have ObjMap_dom_lhs:
"πβ©β ((a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms have ObjMap_dom_rhs: "πβ©β (b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps)
show "(a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ObjMapβ¦ = b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from assms show "vsv (b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦)"
by (cs_concl cs_intro: cat_comma_cs_intros)
fix A assume prems: "A ββ©β b ββ©Cβ©F πβ¦Objβ¦"
with assms obtain b' f'
where A_def: "A = [0, b', f']β©β"
and b': "b' ββ©β πβ¦Objβ¦"
and f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
by auto
from prems assms b' f' show
"(a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ObjMapβ¦β¦Aβ¦ = b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦β¦Aβ¦"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
(
use assms vempty_is_zet in
βΉcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβΊ
)
from assms have ArrMap_dom_lhs:
"πβ©β ((a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms vempty_is_zet have ArrMap_dom_rhs:
"πβ©β (b β©Oβ¨
β©Cβ©F πβ¦ObjMapβ¦) = b ββ©Cβ©F πβ¦Objβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps)
from assms vempty_is_zet have ArrMap_dom_lhs:
"πβ©β ((a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ArrMapβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms have ArrMap_dom_rhs:
"πβ©β (b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦) = b ββ©Cβ©F πβ¦Arrβ¦"
by (cs_concl cs_simp: cat_comma_cs_simps)
show "(a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ArrMapβ¦ = b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix F assume "F ββ©β b ββ©Cβ©F πβ¦Arrβ¦"
then obtain A B where F: "F : A β¦βb ββ©Cβ©F πβ B"
by (auto dest: is_arrI)
with assms obtain b' f' b'' f'' h
where F_def: "F = [[0, b', f']β©β, [0, b'', f'']β©β, [0, h]β©β]β©β"
and A_def: "A = [0, b', f']β©β"
and B_def: "B = [0, b'', f'']β©β"
and h: "h : b' β¦βπβ b''"
and f': "f' : b β¦βπ
β πβ¦ObjMapβ¦β¦b'β¦"
and f'': "f'' : b β¦βπ
β πβ¦ObjMapβ¦β¦b''β¦"
and f''_def: "πβ¦ArrMapβ¦β¦hβ¦ ββ©Aβπ
β f' = f''"
by auto
from vempty_is_zet h assms f' f'' F show
"(a β©Oβ¨
β©Cβ©F π ββ©Cβ©F f β©Aββ©Cβ©F π)β¦ArrMapβ¦β¦Fβ¦ = b β©Oβ¨
β©Cβ©F πβ¦ArrMapβ¦β¦Fβ¦"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)+
qed
(
use assms vempty_is_zet in
βΉcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβΊ
)
qed simp_all
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Rel
sectionβΉβΉRelβΊβΊ
theory CZH_ECAT_Rel
imports
CZH_Foundations.CZH_SMC_Rel
CZH_ECAT_Functor
CZH_ECAT_Small_Category
begin
subsectionβΉBackgroundβΊ
textβΉ
The methodology chosen for the exposition of βΉRelβΊ as a category is analogous
to the one used in the previous installment of this work
for the exposition of βΉRelβΊ as a semicategory.
The general references for this section are Chapter I-7 in
\cite{mac_lane_categories_2010} and nLab
\cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/Rel}
}.
βΊ
named_theorems cat_Rel_cs_simps
named_theorems cat_Rel_cs_intros
lemmas (in arr_Rel) [cat_Rel_cs_simps] =
dg_Rel_shared_cs_simps
lemmas [cat_Rel_cs_simps] =
dg_Rel_shared_cs_simps
arr_Rel.arr_Rel_length
arr_Rel_comp_Rel_id_Rel_left
arr_Rel_comp_Rel_id_Rel_right
arr_Rel.arr_Rel_converse_Rel_converse_Rel
arr_Rel_converse_Rel_eq_iff
arr_Rel_converse_Rel_comp_Rel
arr_Rel_comp_Rel_converse_Rel_left_if_v11
arr_Rel_comp_Rel_converse_Rel_right_if_v11
lemmas [cat_Rel_cs_intros] =
dg_Rel_shared_cs_intros
arr_Rel_comp_Rel
arr_Rel.arr_Rel_converse_Rel
subsectionβΉβΉRelβΊ as a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_Rel :: "V β V"
where "cat_Rel Ξ± =
[
Vset Ξ±,
set {T. arr_Rel Ξ± T},
(Ξ»Tββ©βset {T. arr_Rel Ξ± T}. Tβ¦ArrDomβ¦),
(Ξ»Tββ©βset {T. arr_Rel Ξ± T}. Tβ¦ArrCodβ¦),
(Ξ»STββ©βcomposable_arrs (dg_Rel Ξ±). STβ¦0β¦ ββ©Rβ©eβ©l STβ¦1β©ββ¦),
VLambda (Vset Ξ±) id_Rel
]β©β"
textβΉComponents.βΊ
lemma cat_Rel_components:
shows "cat_Rel Ξ±β¦Objβ¦ = Vset Ξ±"
and "cat_Rel Ξ±β¦Arrβ¦ = set {T. arr_Rel Ξ± T}"
and "cat_Rel Ξ±β¦Domβ¦ = (Ξ»Tββ©βset {T. arr_Rel Ξ± T}. Tβ¦ArrDomβ¦)"
and "cat_Rel Ξ±β¦Codβ¦ = (Ξ»Tββ©βset {T. arr_Rel Ξ± T}. Tβ¦ArrCodβ¦)"
and "cat_Rel Ξ±β¦Compβ¦ = (Ξ»STββ©βcomposable_arrs (dg_Rel Ξ±). STβ¦0β¦ ββ©Rβ©eβ©l STβ¦1β©ββ¦)"
and "cat_Rel Ξ±β¦CIdβ¦ = VLambda (Vset Ξ±) id_Rel"
unfolding cat_Rel_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_cat_Rel: "cat_smc (cat_Rel Ξ±) = smc_Rel Ξ±"
proof(rule vsv_eqI)
show "vsv (cat_smc (cat_Rel Ξ±))" unfolding cat_smc_def by auto
show "vsv (smc_Rel Ξ±)" unfolding smc_Rel_def by auto
have dom_lhs: "πβ©β (cat_smc (cat_Rel Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_Rel Ξ±) = 5β©β"
unfolding smc_Rel_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_Rel Ξ±)) = πβ©β (smc_Rel Ξ±)"
unfolding dom_lhs dom_rhs by simp
show
"a ββ©β πβ©β (cat_smc (cat_Rel Ξ±)) βΉ cat_smc (cat_Rel Ξ±)β¦aβ¦ = smc_Rel Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_Rel_def smc_Rel_def
)
(auto simp: nat_omega_simps)
qed
lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps]:
cat_Rel_Obj_iff = smc_Rel_Obj_iff
and cat_Rel_Arr_iff[cat_Rel_cs_simps] = smc_Rel_Arr_iff
and cat_Rel_Dom_vsv[cat_Rel_cs_intros] = smc_Rel_Dom_vsv
and cat_Rel_Dom_vdomain[cat_Rel_cs_simps] = smc_Rel_Dom_vdomain
and cat_Rel_Dom_app[cat_Rel_cs_simps] = smc_Rel_Dom_app
and cat_Rel_Dom_vrange = smc_Rel_Dom_vrange
and cat_Rel_Cod_vsv[cat_Rel_cs_intros] = smc_Rel_Cod_vsv
and cat_Rel_Cod_vdomain[cat_Rel_cs_simps] = smc_Rel_Cod_vdomain
and cat_Rel_Cod_app[cat_Rel_cs_simps] = smc_Rel_Cod_app
and cat_Rel_Cod_vrange = smc_Rel_Cod_vrange
and cat_Rel_is_arrI[cat_Rel_cs_intros] = smc_Rel_is_arrI
and cat_Rel_is_arrD = smc_Rel_is_arrD
and cat_Rel_is_arrE = smc_Rel_is_arrE
lemmas_with [folded cat_smc_cat_Rel, unfolded slicing_simps, unfolded cat_smc_cat_Rel]:
cat_Rel_composable_arrs_dg_Rel = smc_Rel_composable_arrs_dg_Rel
and cat_Rel_Comp = smc_Rel_Comp
and cat_Rel_Comp_app[cat_Rel_cs_simps] = smc_Rel_Comp_app
and cat_Rel_Comp_vdomain[simp] = smc_Rel_Comp_vdomain
lemmas [cat_cs_simps] = cat_Rel_is_arrD(2,3)
lemmas [cat_Rel_cs_intros] = cat_Rel_is_arrI
lemmas_with (in π΅) [folded cat_smc_cat_Rel, unfolded slicing_simps]:
cat_Rel_Hom_vifunion_in_Vset = smc_Rel_Hom_vifunion_in_Vset
and cat_Rel_incl_Rel_is_arr = smc_Rel_incl_Rel_is_arr
and cat_Rel_incl_Rel_is_arr'[cat_Rel_cs_intros] = smc_Rel_incl_Rel_is_arr'
and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange
and cat_Rel_is_monic_arrI = smc_Rel_is_monic_arrI
and cat_Rel_is_monic_arrD = smc_Rel_is_monic_arrD
and cat_Rel_is_monic_arr = smc_Rel_is_monic_arr
and cat_Rel_is_monic_arr_is_epic_arr = smc_Rel_is_monic_arr_is_epic_arr
and cat_Rel_is_epic_arr_is_monic_arr = smc_Rel_is_epic_arr_is_monic_arr
and cat_Rel_is_epic_arrI = smc_Rel_is_epic_arrI
and cat_Rel_is_epic_arrD = smc_Rel_is_epic_arrD
and cat_Rel_is_epic_arr = smc_Rel_is_epic_arr
and cat_Rel_obj_terminal = smc_Rel_obj_terminal
and cat_Rel_obj_initial = smc_Rel_obj_initial
and cat_Rel_obj_terminal_obj_initial = smc_Rel_obj_terminal_obj_initial
and cat_Rel_obj_null = smc_Rel_obj_null
and cat_Rel_is_zero_arr = smc_Rel_is_zero_arr
lemmas [cat_Rel_cs_intros] = π΅.cat_Rel_incl_Rel_is_arr'
subsubsectionβΉIdentityβΊ
lemma (in π΅) cat_Rel_CId_app[cat_Rel_cs_simps]:
assumes "T ββ©β Vset Ξ±"
shows "cat_Rel Ξ±β¦CIdβ¦β¦Tβ¦ = id_Rel T"
using assms unfolding cat_Rel_components by simp
lemmas [cat_Rel_cs_simps] = π΅.cat_Rel_CId_app
subsubsectionβΉβΉRelβΊ is a categoryβΊ
lemma (in π΅) category_cat_Rel: "category Ξ± (cat_Rel Ξ±)"
proof(rule categoryI, unfold cat_smc_cat_Rel)
interpret Rel: semicategory Ξ± βΉcat_smc (cat_Rel Ξ±)βΊ
unfolding cat_smc_cat_Rel by (simp add: semicategory_smc_Rel)
show "vfsequence (cat_Rel Ξ±)" unfolding cat_Rel_def by simp
show "vcard (cat_Rel Ξ±) = 6β©β"
unfolding cat_Rel_def by (simp add: nat_omega_simps)
show "cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦ : A β¦βcat_Rel Ξ±β A"
if "A ββ©β cat_Rel Ξ±β¦Objβ¦" for A
using that
unfolding cat_Rel_Obj_iff
by
(
cs_concl
cs_simp: cat_Rel_cs_simps cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
)
show "cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦ ββ©Aβcat_Rel Ξ±β F = F"
if "F : A β¦βcat_Rel Ξ±β B" for F A B
proof-
from that have "arr_Rel Ξ± F" "A ββ©β Vset Ξ±" "B ββ©β Vset Ξ±"
by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
)
qed
show "F ββ©Aβcat_Rel Ξ±β cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦ = F"
if "F : B β¦βcat_Rel Ξ±β C" for F B C
proof-
from that have "arr_Rel Ξ± F" "B ββ©β Vset Ξ±" "C ββ©β Vset Ξ±"
by (auto elim: cat_Rel_is_arrE simp: cat_Rel_cs_simps)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_Rel_cs_intros arr_Rel_id_RelI
)
qed
qed (auto simp: semicategory_smc_Rel cat_Rel_components)
lemma (in π΅) category_cat_Rel'[cat_Rel_cs_intros]:
assumes "Ξ±' = Ξ±" and "Ξ±'' = Ξ±"
shows "category Ξ±' (cat_Rel Ξ±'')"
unfolding assms by (rule category_cat_Rel)
lemmas [cat_Rel_cs_intros] = π΅.category_cat_Rel'
subsectionβΉCanonical dagger for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_dag_Rel :: "V β V" (βΉβ β©Cβ©.β©Rβ©eβ©lβΊ)
where "β β©Cβ©.β©Rβ©eβ©l Ξ± =
[
vid_on (cat_Rel Ξ±β¦Objβ¦),
VLambda (cat_Rel Ξ±β¦Arrβ¦) converse_Rel,
op_cat (cat_Rel Ξ±),
cat_Rel Ξ±
]β©β"
textβΉComponents.βΊ
lemma cf_dag_Rel_components:
shows "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ObjMapβ¦ = vid_on (cat_Rel Ξ±β¦Objβ¦)"
and "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦ = VLambda (cat_Rel Ξ±β¦Arrβ¦) converse_Rel"
and "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦HomDomβ¦ = op_cat (cat_Rel Ξ±)"
and "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦HomCodβ¦ = cat_Rel Ξ±"
unfolding cf_dag_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cf_smcf_cf_dag_Rel: "cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ±) = β β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ±)) = 4β©β"
unfolding cf_smcf_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (β β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ±) = 4β©β"
unfolding smcf_dag_Rel_def by (simp add: nat_omega_simps)
show "πβ©β (cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ±)) = πβ©β (β β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "A ββ©β πβ©β (cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ±)) βΉ cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ±)β¦Aβ¦ = β β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ±β¦Aβ¦"
for A
by
(
unfold dom_lhs,
elim_in_numeral,
unfold dghm_field_simps[symmetric],
unfold
cat_smc_cat_Rel
slicing_commute[symmetric]
cf_smcf_components
smcf_dag_Rel_components
cf_dag_Rel_components
smc_Rel_components
cat_Rel_components
)
simp_all
qed (auto simp: cf_smcf_def smcf_dag_Rel_def)
lemmas_with [folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps]:
cf_dag_Rel_ObjMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ObjMap_vsv
and cf_dag_Rel_ObjMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vdomain
and cf_dag_Rel_ObjMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_app
and cf_dag_Rel_ObjMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ObjMap_vrange
and cf_dag_Rel_ArrMap_vsv[cat_Rel_cs_intros] = smcf_dag_Rel_ArrMap_vsv
and cf_dag_Rel_ArrMap_vdomain[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vdomain
and cf_dag_Rel_ArrMap_app[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_app
and cf_dag_Rel_ArrMap_vrange[cat_Rel_cs_simps] = smcf_dag_Rel_ArrMap_vrange
lemmas_with (in π΅) [
folded cat_smc_cat_Rel cf_smcf_cf_dag_Rel, unfolded slicing_simps
]:
cf_dag_Rel_app_is_arr[cat_Rel_cs_intros] = smcf_dag_Rel_app_is_arr
and cf_dag_Rel_ArrMap_smc_Rel_Comp[cat_Rel_cs_simps] =
smcf_dag_Rel_ArrMap_smc_Rel_Comp
subsubsectionβΉCanonical dagger is a contravariant isomorphism of βΉRelβΊβΊ
lemma (in π΅) cf_dag_Rel_is_iso_functor:
"β β©Cβ©.β©Rβ©eβ©l Ξ± : op_cat (cat_Rel Ξ±) β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β cat_Rel Ξ±"
proof
(
rule is_iso_functorI,
unfold
cat_smc_cat_Rel
cf_smcf_cf_dag_Rel
cat_Rel_components
cat_op_simps
slicing_commute[symmetric]
)
interpret is_iso_semifunctor Ξ± βΉop_smc (smc_Rel Ξ±)βΊ βΉsmc_Rel Ξ±βΊ βΉβ β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ±βΊ
by (rule smcf_dag_Rel_is_iso_semifunctor)
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
show "β β©Cβ©.β©Rβ©eβ©l Ξ± : op_cat (cat_Rel Ξ±) β¦β¦β©CβΞ±β cat_Rel Ξ±"
proof
(
rule is_functorI,
unfold
cat_smc_cat_Rel
cf_smcf_cf_dag_Rel
cat_op_simps
slicing_commute[symmetric]
cf_dag_Rel_components(3,4)
)
show "vfsequence (β β©Cβ©.β©Rβ©eβ©l Ξ±)"
unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
show "vcard (β β©Cβ©.β©Rβ©eβ©l Ξ±) = 4β©β"
unfolding cf_dag_Rel_def by (simp add: nat_omega_simps)
show "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦cat_Rel Ξ±β¦CIdβ¦β¦Cβ¦β¦ = cat_Rel Ξ±β¦CIdβ¦β¦β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ObjMapβ¦β¦Cβ¦β¦"
if "C ββ©β cat_Rel Ξ±β¦Objβ¦" for C
proof-
from that have "C ββ©β Vset Ξ±"
by (auto elim: cat_Rel_is_arrE simp: cat_Rel_Obj_iff)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_Rel_cs_simps cs_intro: cat_cs_intros arr_Rel_id_RelI
)
qed
qed (auto simp: cat_cs_intros intro: smc_cs_intros)
show "β β©Sβ©Mβ©Cβ©.β©Rβ©eβ©l Ξ± : op_smc (smc_Rel Ξ±) β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β smc_Rel Ξ±"
by (rule smcf_dag_Rel_is_iso_semifunctor)
qed
lemma (in π΅) cf_dag_Rel_is_iso_functor'[cat_cs_intros]:
assumes "π' = op_cat (cat_Rel Ξ±)"
and "π
' = cat_Rel Ξ±"
and "Ξ±' = Ξ±"
shows "β β©Cβ©.β©Rβ©eβ©l Ξ± : π' β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±'β π
'"
unfolding assms by (rule cf_dag_Rel_is_iso_functor)
lemmas [cat_cs_intros] = π΅.cf_dag_Rel_is_iso_functor'
subsubsectionβΉFurther properties of the canonical daggerβΊ
lemma (in π΅) cf_cn_comp_cf_dag_Rel_cf_dag_Rel:
"β β©Cβ©.β©Rβ©eβ©l Ξ± β©Cβ©Fβ β β©Cβ©.β©Rβ©eβ©l Ξ± = cf_id (cat_Rel Ξ±)"
proof(rule cf_smcf_eqI)
interpret category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
from cf_dag_Rel_is_iso_functor have dag:
"β β©Cβ©.β©Rβ©eβ©l Ξ± : op_cat (cat_Rel Ξ±) β¦β¦β©CβΞ±β cat_Rel Ξ±"
by (simp add: is_iso_functor.axioms(1))
from cf_cn_comp_is_functorI[OF category_axioms dag dag] show
"β β©Cβ©.β©Rβ©eβ©l Ξ± β©Cβ©Fβ β β©Cβ©.β©Rβ©eβ©l Ξ± : cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±" .
show "cf_id (cat_Rel Ξ±) : cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
by (auto simp: category.cat_cf_id_is_functor category_axioms)
show "cf_smcf (β β©Cβ©.β©Rβ©eβ©l Ξ± β©Cβ©Fβ β β©Cβ©.β©Rβ©eβ©l Ξ±) = cf_smcf (smcf_id (cat_Rel Ξ±))"
unfolding slicing_commute[symmetric] cat_smc_cat_Rel cf_smcf_cf_dag_Rel
by (simp add: smcf_cn_comp_smcf_dag_Rel_smcf_dag_Rel)
qed simp_all
subsectionβΉIsomorphismβΊ
context π΅
begin
context
begin
private lemma cat_Rel_is_arr_isomorphism_right_vsubset:
assumes "S : B β¦βcat_Rel Ξ±β A"
and "T : A β¦βcat_Rel Ξ±β B"
and "S ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
and "T ββ©Aβcat_Rel Ξ±β S = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦"
shows "Sβ¦ArrValβ¦ ββ©β (Tβ¦ArrValβ¦)Β―β©β"
proof(rule vsubset_antisym vsubsetI)
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (simp add: category_cat_Rel)
interpret S: arr_Rel Ξ± S
rewrites "Sβ¦ArrDomβ¦ = B" and "Sβ¦ArrCodβ¦ = A"
using assms(1)
by (allβΉelim Rel.cat_is_arrEβΊ) (simp_all add: cat_Rel_components)
interpret T: arr_Rel Ξ± T
rewrites "Tβ¦ArrDomβ¦ = A" and "Tβ¦ArrCodβ¦ = B"
using assms(2)
by (allβΉelim Rel.cat_is_arrEβΊ) (simp_all add: cat_Rel_components)
interpret dag: is_iso_functor Ξ± βΉop_cat (cat_Rel Ξ±)βΊ βΉcat_Rel Ξ±βΊ βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±βΊ
by (auto simp: cf_dag_Rel_is_iso_functor)
from assms(2) have A: "A ββ©β cat_Rel Ξ±β¦Objβ¦" by auto
from assms(3) have "(S ββ©Aβcat_Rel Ξ±β T)β¦ArrValβ¦ = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦β¦ArrValβ¦"
by simp
with A have [simp]: "Sβ¦ArrValβ¦ ββ©β Tβ¦ArrValβ¦ = vid_on A"
unfolding cat_Rel_Comp_app[OF assms(1,2)]
by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)
from assms(2) have B: "B ββ©β cat_Rel Ξ±β¦Objβ¦" by auto
from assms(4) have "(T ββ©Aβcat_Rel Ξ±β S)β¦ArrValβ¦ = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦β¦ArrValβ¦"
by simp
with B have [simp]: "Tβ¦ArrValβ¦ ββ©β Sβ¦ArrValβ¦ = vid_on B"
unfolding cat_Rel_Comp_app[OF assms(2,1)]
by (simp add: id_Rel_components comp_Rel_components cat_Rel_components)
fix ab assume ab: "ab ββ©β Sβ¦ArrValβ¦"
with S.vbrelation obtain a b where ab_def: "ab = β¨a, bβ©" and "a ββ©β B"
by (metis S.arr_Rel_ArrVal_vdomain S.ArrVal.vbrelation_vinE vsubsetE)
then have "β¨a, aβ© ββ©β Tβ¦ArrValβ¦ ββ©β Sβ¦ArrValβ¦" by auto
then obtain c where "β¨a, cβ© ββ©β Sβ¦ArrValβ¦" and ca[intro]: "β¨c, aβ© ββ©β Tβ¦ArrValβ¦"
by blast
have "β¨b, aβ© ββ©β Tβ¦ArrValβ¦"
proof(rule ccontr)
assume "β¨b, aβ© ββ©β Tβ¦ArrValβ¦"
with ca have "c β b" by clarsimp
moreover from ab have "β¨c, bβ© ββ©β Sβ¦ArrValβ¦ ββ©β Tβ¦ArrValβ¦"
unfolding ab_def by blast
ultimately show False by (simp add: vid_on_iff)
qed
then show "ab ββ©β (Tβ¦ArrValβ¦)Β―β©β" unfolding ab_def by clarsimp
qed
private lemma cat_Rel_is_arr_isomorphism_left_vsubset:
assumes "S : B β¦βcat_Rel Ξ±β A"
and "T : A β¦βcat_Rel Ξ±β B"
and "S ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
and "T ββ©Aβcat_Rel Ξ±β S = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦"
shows "(Tβ¦ArrValβ¦)Β―β©β ββ©β Sβ¦ArrValβ¦"
using assms(2,3,4) cat_Rel_is_arr_isomorphism_right_vsubset[OF assms(2,1)]
by auto
private lemma is_arr_isomorphism_dag:
assumes "S : B β¦βcat_Rel Ξ±β A"
and "T : A β¦βcat_Rel Ξ±β B"
and "S ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
and "T ββ©Aβcat_Rel Ξ±β S = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦"
shows "S = β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦"
proof(rule arr_Rel_eqI[of Ξ±])
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
interpret dag: is_iso_functor Ξ± βΉop_cat (cat_Rel Ξ±)βΊ βΉcat_Rel Ξ±βΊ βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±βΊ
by (auto simp: cf_dag_Rel_is_iso_functor)
from assms(1) show S: "arr_Rel Ξ± S" by (fastforce simp: cat_Rel_components(2))
from cf_dag_Rel_app_is_arr[OF assms(2)] show "arr_Rel Ξ± (β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦)"
by (auto elim!: cat_Rel_is_arrE)
from assms(2) have T: "arr_Rel Ξ± T" by (auto simp: cat_Rel_is_arrD(1))
from S T assms show "Sβ¦ArrValβ¦ = β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦β¦ArrValβ¦"
unfolding cf_dag_Rel_ArrMap_app[OF T] converse_Rel_components
by (intro vsubset_antisym)
(
simp_all add:
cat_Rel_is_arr_isomorphism_left_vsubset
cat_Rel_is_arr_isomorphism_right_vsubset
)
from T assms show "Sβ¦ArrDomβ¦ = β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦β¦ArrDomβ¦"
unfolding cf_dag_Rel_components
by (auto simp: cat_cs_simps cat_Rel_cs_simps converse_Rel_components(1))
from S assms show "Sβ¦ArrCodβ¦ = β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦β¦ArrCodβ¦"
by
(
cs_concl
cs_intro: cat_op_intros cat_cs_intros
cs_simp: cat_Rel_cs_simps cat_cs_simps
)
qed
lemma cat_Rel_is_arr_isomorphismI[intro]:
assumes "T : A β¦βcat_Rel Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
shows "T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
proof(rule is_arr_isomorphismI[where ?g = βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦βΊ])
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
interpret v11: v11 βΉTβ¦ArrValβ¦βΊ by (rule assms(2))
interpret T: arr_Rel Ξ± T
rewrites [simp]: "Tβ¦ArrDomβ¦ = A" and [simp]: "Tβ¦ArrCodβ¦ = B"
using assms(1)
by (allβΉelim cat_Rel_is_arrEβΊ) (simp_all add: cat_Rel_components)
interpret is_iso_functor Ξ± βΉop_cat (cat_Rel Ξ±)βΊ βΉcat_Rel Ξ±βΊ βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±βΊ
by (simp add: cf_dag_Rel_is_iso_functor)
show "T : A β¦βcat_Rel Ξ±β B" by (rule assms(1))
show "is_inverse (cat_Rel Ξ±) (β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦) T"
proof(intro is_inverseI)
from assms(1) show dag_T: "β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦ : B β¦βcat_Rel Ξ±β A"
by
(
cs_concl
cs_simp: cat_op_simps cat_Rel_cs_simps
cs_intro: cat_cs_intros
)
show T: "T : A β¦βcat_Rel Ξ±β B" by (rule assms(1))
from T T.arr_Rel_axioms v11.v11_axioms assms(3) show
"β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦ ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_cs_intros cat_Rel_cs_intros
)
from T T.arr_Rel_axioms v11.v11_axioms assms(4) show
"T ββ©Aβcat_Rel Ξ±β β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦ = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_cs_intros cat_Rel_cs_intros
)
qed
qed
lemma cat_Rel_is_arr_isomorphismD[dest]:
assumes "T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
shows "T : A β¦βcat_Rel Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
proof-
from assms show T: "T : A β¦βcat_Rel Ξ±β B"
by (simp add: is_arr_isomorphism_def)
interpret T: arr_Rel Ξ± T
rewrites [simp]: "Tβ¦ArrDomβ¦ = A" and [simp]: "Tβ¦ArrCodβ¦ = B"
using T
by (allβΉelim cat_Rel_is_arrEβΊ) (simp_all add: cat_Rel_components)
interpret is_iso_functor Ξ± βΉop_cat (cat_Rel Ξ±)βΊ βΉcat_Rel Ξ±βΊ βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±βΊ
by (simp add: cf_dag_Rel_is_iso_functor)
from is_arr_isomorphismD[OF assms(1)] obtain S where
"is_inverse (cat_Rel Ξ±) S T"
by clarsimp
from is_inverseD[OF this] obtain A' B' where "S : B' β¦βcat_Rel Ξ±β A'"
and "T : A' β¦βcat_Rel Ξ±β B'"
and "S ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦A'β¦"
and "T ββ©Aβcat_Rel Ξ±β S = cat_Rel Ξ±β¦CIdβ¦β¦B'β¦"
by auto
moreover with T have "A' = A" "B' = B" by auto
ultimately have S: "S : B β¦βcat_Rel Ξ±β A"
and ST: "S ββ©Aβcat_Rel Ξ±β T = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
and TS: "T ββ©Aβcat_Rel Ξ±β S = cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦"
by auto
from S T ST TS have S_def: "S = β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦"
by (rule is_arr_isomorphism_dag)
interpret S: arr_Rel Ξ± βΉβ β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦βΊ
rewrites "(β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦)β¦ArrDomβ¦ = B"
and "(β β©Cβ©.β©Rβ©eβ©l Ξ±β¦ArrMapβ¦β¦Tβ¦)β¦ArrCodβ¦ = A"
by (fold S_def, insert S, allβΉelim cat_Rel_is_arrEβΊ)
(simp_all add: cat_Rel_components)
from T.arr_Rel_axioms S_def have S_T: "Sβ¦ArrValβ¦ = (Tβ¦ArrValβ¦)Β―β©β"
by (simp add: cf_dag_Rel_ArrMap_app converse_Rel_components(1))
from S have A: "A ββ©β cat_Rel Ξ±β¦Objβ¦" and B: "B ββ©β cat_Rel Ξ±β¦Objβ¦" by auto
from B TS A ST have
"(T ββ©Rβ©eβ©l S)β¦ArrValβ¦ = id_Rel Bβ¦ArrValβ¦"
"(S ββ©Rβ©eβ©l T)β¦ArrValβ¦ = id_Rel Aβ¦ArrValβ¦"
unfolding cat_Rel_Comp_app[OF S T] cat_Rel_Comp_app[OF T S]
unfolding cat_Rel_components
by simp_all
then have val_ST: "Sβ¦ArrValβ¦ ββ©β Tβ¦ArrValβ¦ = vid_on A"
and val_TS: "Tβ¦ArrValβ¦ ββ©β Sβ¦ArrValβ¦ = vid_on B"
unfolding comp_Rel_components id_Rel_components by simp_all
show "v11 (Tβ¦ArrValβ¦)"
proof(rule v11I)
show "vsv (Tβ¦ArrValβ¦)"
proof(rule vsvI)
fix a b c assume prems: "β¨a, bβ© ββ©β Tβ¦ArrValβ¦" "β¨a, cβ© ββ©β Tβ¦ArrValβ¦"
from prems(1) S_T have "β¨b, aβ© ββ©β Sβ¦ArrValβ¦" by auto
with prems(2) val_TS have "β¨b, cβ© ββ©β vid_on B" by auto
then show "b = c" by clarsimp
qed (auto simp: T.ArrVal.vbrelation_axioms)
show "vsv ((Tβ¦ArrValβ¦)Β―β©β)"
proof(rule vsvI)
fix a b c
assume prems: "β¨a, bβ© ββ©β (Tβ¦ArrValβ¦)Β―β©β" "β¨a, cβ© ββ©β (Tβ¦ArrValβ¦)Β―β©β"
with S_T have "β¨a, bβ© ββ©β Sβ¦ArrValβ¦" and "β¨a, cβ© ββ©β Sβ¦ArrValβ¦" by auto
moreover from prems have "β¨b, aβ© ββ©β Tβ¦ArrValβ¦" and "β¨c, aβ© ββ©β Tβ¦ArrValβ¦"
by auto
ultimately have "β¨b, cβ© ββ©β vid_on A" using val_ST by auto
then show "b = c" by clarsimp
qed auto
qed
show "πβ©β (Tβ¦ArrValβ¦) = A"
proof(intro vsubset_antisym vsubsetI)
fix a assume "a ββ©β A"
with val_ST have "β¨a, aβ© ββ©β Sβ¦ArrValβ¦ ββ©β Tβ¦ArrValβ¦" by auto
then show "a ββ©β πβ©β (Tβ¦ArrValβ¦)" by auto
qed (use T.arr_Rel_ArrVal_vdomain in auto)
show "ββ©β (Tβ¦ArrValβ¦) = B"
proof(intro vsubset_antisym vsubsetI)
fix b assume "b ββ©β B"
with val_TS have "β¨b, bβ© ββ©β Tβ¦ArrValβ¦ ββ©β Sβ¦ArrValβ¦" by auto
then show "b ββ©β ββ©β (Tβ¦ArrValβ¦)" by auto
qed (use T.arr_Rel_ArrVal_vrange in auto)
qed
end
end
lemmas [cat_Rel_cs_simps] = π΅.cat_Rel_is_arr_isomorphismD(3,4)
lemma (in π΅) cat_Rel_is_arr_isomorphism:
"T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B β·
T : A β¦βcat_Rel Ξ±β B β§
v11 (Tβ¦ArrValβ¦) β§
πβ©β (Tβ¦ArrValβ¦) = A β§
ββ©β (Tβ¦ArrValβ¦) = B"
by auto
subsectionβΉThe inverse arrowβΊ
lemma (in π΅) cat_Rel_the_inverse:
assumes "T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
shows "TΒ―β©Cβcat_Rel Ξ±β = TΒ―β©Rβ©eβ©l"
unfolding the_inverse_def
proof(rule the_equality)
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
from assms have T: "T : A β¦βcat_Rel Ξ±β B" by auto
interpret T: arr_Rel Ξ± T
rewrites "Tβ¦ArrDomβ¦ = A" and "Tβ¦ArrCodβ¦ = B"
using T by (allβΉelim cat_Rel_is_arrEβΊ) (simp_all add: cat_Rel_components)
from assms T T.arr_Rel_axioms cat_Rel_is_arr_isomorphismD(2)[OF assms]
show inv_T_T: "is_inverse (cat_Rel Ξ±) (TΒ―β©Rβ©eβ©l) T"
by (intro is_inverseI[where a=A and b=B])
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_Rel_cs_intros cat_cs_intros
)+
fix S assume prems: "is_inverse (cat_Rel Ξ±) S T"
show "S = TΒ―β©Rβ©eβ©l"
by (rule category.cat_is_inverse_eq[OF Rel.category_axioms prems inv_T_T])
qed
lemmas [cat_Rel_cs_simps] = π΅.cat_Rel_the_inverse
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Par
sectionβΉβΉParβΊβΊ
theory CZH_ECAT_Par
imports
CZH_Foundations.CZH_SMC_Par
CZH_ECAT_Rel
CZH_ECAT_Subcategory
begin
subsectionβΉBackgroundβΊ
textβΉ
The methodology chosen for the exposition of βΉParβΊ as a category is
analogous to the one used in the previous installment of this work
for the exposition of βΉParβΊ as a semicategory.
βΊ
named_theorems cat_Par_cs_simps
named_theorems cat_Par_cs_intros
lemmas (in arr_Rel) [cat_Par_cs_simps] =
dg_Rel_shared_cs_simps
lemmas [cat_Par_cs_simps] =
dg_Rel_shared_cs_simps
arr_Par.arr_Par_length
arr_Par_comp_Par_id_Par_left
arr_Par_comp_Par_id_Par_right
lemmas [cat_Par_cs_intros] =
arr_Par_comp_Par
subsectionβΉβΉParβΊ as a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_Par :: "V β V"
where "cat_Par Ξ± =
[
Vset Ξ±,
set {T. arr_Par Ξ± T},
(Ξ»Tββ©βset {T. arr_Par Ξ± T}. Tβ¦ArrDomβ¦),
(Ξ»Tββ©βset {T. arr_Par Ξ± T}. Tβ¦ArrCodβ¦),
(Ξ»STββ©βcomposable_arrs (dg_Par Ξ±). STβ¦0β¦ ββ©Rβ©eβ©l STβ¦1β©ββ¦),
VLambda (Vset Ξ±) id_Par
]β©β"
textβΉComponents.βΊ
lemma cat_Par_components:
shows "cat_Par Ξ±β¦Objβ¦ = Vset Ξ±"
and "cat_Par Ξ±β¦Arrβ¦ = set {T. arr_Par Ξ± T}"
and "cat_Par Ξ±β¦Domβ¦ = (Ξ»Tββ©βset {T. arr_Par Ξ± T}. Tβ¦ArrDomβ¦)"
and "cat_Par Ξ±β¦Codβ¦ = (Ξ»Tββ©βset {T. arr_Par Ξ± T}. Tβ¦ArrCodβ¦)"
and "cat_Par Ξ±β¦Compβ¦ = (Ξ»STββ©βcomposable_arrs (dg_Par Ξ±). STβ¦0β¦ ββ©Pβ©aβ©r STβ¦1β©ββ¦)"
and "cat_Par Ξ±β¦CIdβ¦ = VLambda (Vset Ξ±) id_Par"
unfolding cat_Par_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_cat_Par: "cat_smc (cat_Par Ξ±) = smc_Par Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cat_smc (cat_Par Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_Par Ξ±) = 5β©β"
unfolding smc_Par_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_Par Ξ±)) = πβ©β (smc_Par Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_Par Ξ±)) βΉ cat_smc (cat_Par Ξ±)β¦aβ¦ = smc_Par Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_Par_def smc_Par_def
)
(auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_Par_def)
lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]:
cat_Par_Obj_iff = smc_Par_Obj_iff
and cat_Par_Arr_iff[cat_Par_cs_simps] = smc_Par_Arr_iff
and cat_Par_Dom_vsv[cat_Par_cs_intros] = smc_Par_Dom_vsv
and cat_Par_Dom_vdomain[cat_Par_cs_simps] = smc_Par_Dom_vdomain
and cat_Par_Dom_vrange = smc_Par_Dom_vrange
and cat_Par_Dom_app[cat_Par_cs_simps] = smc_Par_Dom_app
and cat_Par_Cod_vsv[cat_Par_cs_intros] = smc_Par_Cod_vsv
and cat_Par_Cod_vdomain[cat_Par_cs_simps] = smc_Par_Cod_vdomain
and cat_Par_Cod_vrange = smc_Par_Cod_vrange
and cat_Par_Cod_app[cat_Par_cs_simps] = smc_Par_Cod_app
and cat_Par_is_arrI = smc_Par_is_arrI
and cat_Par_is_arrD = smc_Par_is_arrD
and cat_Par_is_arrE = smc_Par_is_arrE
lemmas_with [folded cat_smc_cat_Par, unfolded slicing_simps]:
cat_Par_composable_arrs_dg_Par = smc_Par_composable_arrs_dg_Par
and cat_Par_Comp = smc_Par_Comp
and cat_Par_Comp_app[cat_Par_cs_simps] = smc_Par_Comp_app
and cat_Par_Comp_vdomain[cat_Par_cs_simps] = smc_Par_Comp_vdomain
lemmas [cat_cs_simps] = cat_Par_is_arrD(2,3)
lemmas [cat_Par_cs_intros] = cat_Par_is_arrI
lemmas_with (in π΅) [folded cat_smc_cat_Par, unfolded slicing_simps]:
cat_Par_Hom_vifunion_in_Vset = smc_Par_Hom_vifunion_in_Vset
and cat_Par_incl_Par_is_arr = smc_Par_incl_Par_is_arr
and cat_Par_incl_Par_is_arr'[cat_Par_cs_intros] = smc_Par_incl_Par_is_arr'
and cat_Par_Comp_vrange = smc_Par_Comp_vrange
and cat_Par_is_monic_arrI = smc_Par_is_monic_arrI
and cat_Par_is_monic_arr = smc_Par_is_monic_arr
and cat_Par_is_epic_arrI = smc_Par_is_epic_arrI
and cat_Par_is_epic_arrD = smc_Par_is_epic_arrD
and cat_Par_is_epic_arr = smc_Par_is_epic_arr
and cat_Par_obj_terminal = smc_Par_obj_terminal
and cat_Par_obj_initial = smc_Par_obj_initial
and cat_Par_obj_terminal_obj_initial = smc_Par_obj_terminal_obj_initial
and cat_Par_obj_null = smc_Par_obj_null
and cat_Par_is_zero_arr = smc_Par_is_zero_arr
lemmas [cat_Par_cs_intros] = π΅.cat_Par_incl_Par_is_arr'
subsubsectionβΉIdentityβΊ
lemma cat_Par_CId_app[cat_Par_cs_simps]:
assumes "A ββ©β Vset Ξ±"
shows "cat_Par Ξ±β¦CIdβ¦β¦Aβ¦ = id_Par A"
using assms unfolding cat_Par_components by simp
lemma id_Par_CId_app_app[cat_cs_simps]:
assumes "A ββ©β Vset Ξ±" and "a ββ©β A"
shows "cat_Par Ξ±β¦CIdβ¦β¦Aβ¦β¦ArrValβ¦β¦aβ¦ = a"
unfolding cat_Par_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp
subsubsectionβΉβΉParβΊ is a categoryβΊ
lemma (in π΅) category_cat_Par: "category Ξ± (cat_Par Ξ±)"
proof(intro categoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par cat_op_simps)
interpret Par: semicategory Ξ± βΉcat_smc (cat_Par Ξ±)βΊ
unfolding cat_smc_cat_Par by (simp add: semicategory_smc_Par)
show "vfsequence (cat_Par Ξ±)" unfolding cat_Par_def by simp
show "vcard (cat_Par Ξ±) = 6β©β"
unfolding cat_Par_def by (simp add: nat_omega_simps)
show "cat_Par Ξ±β¦CIdβ¦β¦Aβ¦ : A β¦βcat_Par Ξ±β A" if "A ββ©β cat_Par Ξ±β¦Objβ¦" for A
using that
unfolding cat_Par_Obj_iff
by
(
cs_concl
cs_simp: cat_Par_cs_simps cs_intro: cat_Par_cs_intros arr_Par_id_ParI
)
show "cat_Par Ξ±β¦CIdβ¦β¦Bβ¦ ββ©Aβcat_Par Ξ±β F = F"
if "F : A β¦βcat_Par Ξ±β B" for F A B
proof-
from that have "arr_Par Ξ± F" "B ββ©β Vset Ξ±"
by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
with that π΅_axioms show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Par_cs_simps
cs_intro: cat_Par_cs_intros arr_Par_id_ParI
)
qed
show "F ββ©Aβcat_Par Ξ±β cat_Par Ξ±β¦CIdβ¦β¦Bβ¦ = F"
if "F : B β¦βcat_Par Ξ±β C" for F B C
proof-
from that have "arr_Par Ξ± F" "B ββ©β Vset Ξ±"
by (auto elim: cat_Par_is_arrE simp: cat_Par_cs_simps)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Par_cs_simps
cs_intro: cat_Par_cs_intros arr_Par_id_ParI
)
qed
qed (auto simp: semicategory_smc_Par cat_Par_components)
subsubsectionβΉβΉParβΊ is a wide replete subcategory of βΉRelβΊβΊ
lemma (in π΅) wide_replete_subcategory_cat_Par_cat_Rel:
"cat_Par Ξ± ββ©Cβ©.β©wβ©rβΞ±β cat_Rel Ξ±"
proof(intro wide_replete_subcategoryI)
show wide_subcategory_cat_Par_cat_Rel: "cat_Par Ξ± ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β cat_Rel Ξ±"
proof(intro wide_subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
interpret Par: category Ξ± βΉcat_Par Ξ±βΊ by (rule category_cat_Par)
interpret wide_subsemicategory Ξ± βΉsmc_Par Ξ±βΊ βΉsmc_Rel Ξ±βΊ
by (simp add: wide_subsemicategory_smc_Par_smc_Rel)
show "cat_Par Ξ± ββ©CβΞ±β cat_Rel Ξ±"
proof(intro subcategoryI, unfold cat_smc_cat_Rel cat_smc_cat_Par)
show "smc_Par Ξ± ββ©Sβ©Mβ©CβΞ±β smc_Rel Ξ±" by (simp add: subsemicategory_axioms)
fix A assume "A ββ©β cat_Par Ξ±β¦Objβ¦"
then show "cat_Par Ξ±β¦CIdβ¦β¦Aβ¦ = cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦"
unfolding cat_Par_components cat_Rel_components by simp
qed
(
auto simp:
subsemicategory_axioms Rel.category_axioms Par.category_axioms
)
qed (rule wide_subsemicategory_smc_Par_smc_Rel)
show "cat_Par Ξ± ββ©Cβ©.β©rβ©eβ©pβΞ±β cat_Rel Ξ±"
proof(intro replete_subcategoryI)
interpret wide_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_subcategory_cat_Par_cat_Rel)
show "cat_Par Ξ± ββ©CβΞ±β cat_Rel Ξ±" by (rule subcategory_axioms)
fix A B F assume prems: "A ββ©β cat_Par Ξ±β¦Objβ¦" "F : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
note arr_Rel = cat_Rel_is_arr_isomorphismD[OF prems(2)]
from arr_Rel(2) show "F : A β¦βcat_Par Ξ±β B"
by (intro cat_Par_is_arrI arr_Par_arr_RelI cat_Rel_is_arrD[OF arr_Rel(1)])
auto
qed
qed
subsectionβΉIsomorphismβΊ
lemma (in π΅) cat_Par_is_arr_isomorphismI[intro]:
assumes "T : A β¦βcat_Par Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
shows "T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
proof-
note [cat_cs_intros] = cat_Rel_is_arr_isomorphismI
from wide_replete_subcategory_cat_Par_cat_Rel assms have
"T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
with wide_replete_subcategory_cat_Par_cat_Rel assms show
"T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
by (cs_concl cs_simp: cat_sub_bw_cs_simps)
qed
lemma (in π΅) cat_Par_is_arr_isomorphismD[dest]:
assumes "T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
shows "T : A β¦βcat_Par Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
proof-
from wide_replete_subcategory_cat_Par_cat_Rel assms have T:
"T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
show "v11 (Tβ¦ArrValβ¦)" "πβ©β (Tβ¦ArrValβ¦) = A" "ββ©β (Tβ¦ArrValβ¦) = B"
by (intro cat_Rel_is_arr_isomorphismD[OF T])+
qed (rule is_arr_isomorphismD(1)[OF assms])
lemma (in π΅) cat_Par_is_arr_isomorphism:
"T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B β·
T : A β¦βcat_Par Ξ±β B β§
v11 (Tβ¦ArrValβ¦) β§
πβ©β (Tβ¦ArrValβ¦) = A β§
ββ©β (Tβ¦ArrValβ¦) = B"
by auto
subsectionβΉThe inverse arrowβΊ
abbreviation (input) converse_Par :: "V β V" ("(_Β―β©Pβ©aβ©r)" [1000] 999)
where "aΒ―β©Pβ©aβ©r β‘ aΒ―β©Rβ©eβ©l"
lemma (in π΅) cat_Par_the_inverse:
assumes "T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
shows "TΒ―β©Cβcat_Par Ξ±β = TΒ―β©Pβ©aβ©r"
proof-
from wide_replete_subcategory_cat_Par_cat_Rel assms have T:
"T : A β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
from wide_replete_subcategory_cat_Par_cat_Rel assms have [cat_cs_simps]:
"TΒ―β©Cβcat_Par Ξ±β = TΒ―β©Cβcat_Rel Ξ±β"
by (cs_concl cs_full cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros)
from T show "TΒ―β©Cβcat_Par Ξ±β = TΒ―β©Rβ©eβ©l"
by (cs_concl cs_simp: cat_Rel_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_Par_cs_simps] = π΅.cat_Par_the_inverse
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Set
sectionβΉβΉSetβΊβΊ
theory CZH_ECAT_Set
imports
CZH_Foundations.CZH_SMC_Set
CZH_ECAT_Par
CZH_ECAT_Subcategory
CZH_ECAT_PCategory
begin
subsectionβΉBackgroundβΊ
textβΉ
The methodology chosen for the exposition of βΉSetβΊ as a category is
analogous to the one used in the previous installment of this work
for the exposition of βΉSetβΊ as a semicategory.
βΊ
named_theorems cat_Set_cs_simps
named_theorems cat_Set_cs_intros
lemmas (in arr_Set) [cat_Set_cs_simps] =
dg_Rel_shared_cs_simps
lemmas [cat_Set_cs_simps] =
dg_Rel_shared_cs_simps
arr_Set.arr_Set_ArrVal_vdomain
arr_Set_comp_Set_id_Set_left
arr_Set_comp_Set_id_Set_right
lemmas [cat_Set_cs_intros] =
dg_Rel_shared_cs_intros
arr_Set_comp_Set
named_theorems cat_rel_par_Set_cs_intros
named_theorems cat_rel_par_Set_cs_simps
named_theorems cat_rel_Par_set_cs_intros
named_theorems cat_rel_Par_set_cs_simps
named_theorems cat_Rel_par_set_cs_intros
named_theorems cat_Rel_par_set_cs_simps
subsectionβΉβΉSetβΊ as a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_Set :: "V β V"
where "cat_Set Ξ± =
[
Vset Ξ±,
set {T. arr_Set Ξ± T},
(Ξ»Tββ©βset {T. arr_Set Ξ± T}. Tβ¦ArrDomβ¦),
(Ξ»Tββ©βset {T. arr_Set Ξ± T}. Tβ¦ArrCodβ¦),
(Ξ»STββ©βcomposable_arrs (dg_Set Ξ±). STβ¦0β¦ ββ©Rβ©eβ©l STβ¦1β©ββ¦),
VLambda (Vset Ξ±) id_Set
]β©β"
textβΉComponents.βΊ
lemma cat_Set_components:
shows "cat_Set Ξ±β¦Objβ¦ = Vset Ξ±"
and "cat_Set Ξ±β¦Arrβ¦ = set {T. arr_Set Ξ± T}"
and "cat_Set Ξ±β¦Domβ¦ = (Ξ»Tββ©βset {T. arr_Set Ξ± T}. Tβ¦ArrDomβ¦)"
and "cat_Set Ξ±β¦Codβ¦ = (Ξ»Tββ©βset {T. arr_Set Ξ± T}. Tβ¦ArrCodβ¦)"
and "cat_Set Ξ±β¦Compβ¦ =
(Ξ»STββ©βcomposable_arrs (dg_Set Ξ±). STβ¦0β¦ ββ©Pβ©aβ©r STβ¦1β©ββ¦)"
and "cat_Set Ξ±β¦CIdβ¦ = VLambda (Vset Ξ±) id_Set"
unfolding cat_Set_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_cat_Set: "cat_smc (cat_Set Ξ±) = smc_Set Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cat_smc (cat_Set Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_Set Ξ±) = 5β©β"
unfolding smc_Set_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_Set Ξ±)) = πβ©β (smc_Set Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_Set Ξ±)) βΉ cat_smc (cat_Set Ξ±)β¦aβ¦ = smc_Set Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_Set_def smc_Set_def
)
(auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_Set_def)
lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]:
cat_Set_Obj_iff = smc_Set_Obj_iff
and cat_Set_Arr_iff[cat_Set_cs_simps] = smc_Set_Arr_iff
and cat_Set_Dom_vsv[intro] = smc_Set_Dom_vsv
and cat_Set_Dom_vdomain[simp] = smc_Set_Dom_vdomain
and cat_Set_Dom_vrange = smc_Set_Dom_vrange
and cat_Set_Dom_app = smc_Set_Dom_app
and cat_Set_Cod_vsv[intro] = smc_Set_Cod_vsv
and cat_Set_Cod_vdomain[simp] = smc_Set_Cod_vdomain
and cat_Set_Cod_vrange = smc_Set_Cod_vrange
and cat_Set_Cod_app[cat_Set_cs_simps] = smc_Set_Cod_app
and cat_Set_is_arrI = smc_Set_is_arrI
and cat_Set_is_arrD = smc_Set_is_arrD
and cat_Set_is_arrE = smc_Set_is_arrE
and cat_Set_ArrVal_vdomain[cat_cs_simps] = smc_Set_ArrVal_vdomain
and cat_Set_ArrVal_app_vrange[cat_Set_cs_intros] = smc_Set_ArrVal_app_vrange
lemmas [cat_cs_simps] = cat_Set_is_arrD(2,3)
lemmas [cat_Set_cs_intros] =
cat_Set_is_arrI
lemmas_with [folded cat_smc_cat_Set, unfolded slicing_simps]:
cat_Set_composable_arrs_dg_Set = smc_Set_composable_arrs_dg_Set
and cat_Set_Comp = smc_Set_Comp
and cat_Set_Comp_app[cat_Set_cs_simps] = smc_Set_Comp_app
and cat_Set_Comp_vdomain[cat_Set_cs_simps] = smc_Set_Comp_vdomain
lemmas_with (in π΅) [folded cat_smc_cat_Set, unfolded slicing_simps]:
cat_Set_Hom_vifunion_in_Vset = smc_Set_Hom_vifunion_in_Vset
and cat_Set_incl_Set_is_arr = smc_Set_incl_Set_is_arr
and cat_Set_incl_Set_is_arr'[cat_Set_cs_intros] = smc_Set_incl_Set_is_arr'
and cat_Set_Comp_ArrVal = smc_Set_Comp_ArrVal
and cat_Set_Comp_vrange = smc_Set_Comp_vrange
and cat_Set_is_monic_arrI = smc_Set_is_monic_arrI
and cat_Set_is_monic_arr = smc_Set_is_monic_arr
and cat_Set_is_epic_arrI = smc_Set_is_epic_arrI
and cat_Set_is_epic_arrD = smc_Set_is_epic_arrD
and cat_Set_is_epic_arr = smc_Set_is_epic_arr
and cat_Set_obj_terminal = smc_Set_obj_terminal
and cat_Set_obj_initial = smc_Set_obj_initial
and cat_Set_obj_null = smc_Set_obj_null
and cat_Set_is_zero_arr = smc_Set_is_zero_arr
lemmas [cat_Set_cs_intros] = π΅.cat_Set_incl_Set_is_arr'
lemmas [cat_cs_simps] =
π΅.cat_Set_Comp_ArrVal
subsubsectionβΉIdentityβΊ
lemma cat_Set_CId_app[cat_Set_cs_simps]:
assumes "A ββ©β Vset Ξ±"
shows "cat_Set Ξ±β¦CIdβ¦β¦Aβ¦ = id_Set A"
using assms unfolding cat_Set_components by simp
lemma id_Par_CId_app_app[cat_cs_simps]:
assumes "A ββ©β Vset Ξ±" and "a ββ©β A"
shows "cat_Set Ξ±β¦CIdβ¦β¦Aβ¦β¦ArrValβ¦β¦aβ¦ = a"
unfolding cat_Set_CId_app[OF assms(1)] id_Rel_ArrVal_app[OF assms(2)] by simp
subsubsectionβΉβΉSetβΊ is a categoryβΊ
lemma (in π΅) category_cat_Set: "category Ξ± (cat_Set Ξ±)"
proof(rule categoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
interpret Set: semicategory Ξ± βΉcat_smc (cat_Set Ξ±)βΊ
unfolding cat_smc_cat_Set by (simp add: semicategory_smc_Set)
show "vfsequence (cat_Set Ξ±)" unfolding cat_Set_def by simp
show "vcard (cat_Set Ξ±) = 6β©β"
unfolding cat_Set_def by (simp add: nat_omega_simps)
show "semicategory Ξ± (smc_Set Ξ±)" by (simp add: semicategory_smc_Set)
show "cat_Set Ξ±β¦CIdβ¦β¦Aβ¦ : A β¦βcat_Set Ξ±β A"
if "A ββ©β cat_Set Ξ±β¦Objβ¦" for A
using that
unfolding cat_Set_Obj_iff
by
(
cs_concl
cs_simp: cat_Set_cs_simps cs_intro: cat_Set_cs_intros arr_Set_id_SetI
)
show "cat_Set Ξ±β¦CIdβ¦β¦Bβ¦ ββ©Aβcat_Set Ξ±β F = F"
if "F : A β¦βcat_Set Ξ±β B" for F A B
proof-
from that have "arr_Set Ξ± F" "B ββ©β Vset Ξ±" by (auto elim: cat_Set_is_arrE)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_cs_simps
cs_intro: cat_Set_cs_intros arr_Set_id_SetI
)
qed
show "F ββ©Aβcat_Set Ξ±β cat_Set Ξ±β¦CIdβ¦β¦Bβ¦ = F"
if "F : B β¦βcat_Set Ξ±β C" for F B C
proof-
from that have "arr_Set Ξ± F" "B ββ©β Vset Ξ±" by (auto elim: cat_Set_is_arrE)
with that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_cs_simps
cs_intro: cat_Set_cs_intros arr_Set_id_SetI
)
qed
qed (auto simp: cat_Set_components)
lemma (in π΅) category_cat_Set':
assumes "Ξ² = Ξ±"
shows "category Ξ² (cat_Set Ξ±)"
unfolding assms by (rule category_cat_Set)
lemmas [cat_cs_intros] = π΅.category_cat_Set'
subsubsectionβΉβΉSetβΊ is a wide replete subcategory of βΉParβΊβΊ
lemma (in π΅) wide_replete_subcategory_cat_Set_cat_Par:
"cat_Set Ξ± ββ©Cβ©.β©wβ©rβΞ±β cat_Par Ξ±"
proof(intro wide_replete_subcategoryI)
show wide_subcategory_cat_Set_cat_Par: "cat_Set Ξ± ββ©Cβ©.β©wβ©iβ©dβ©eβΞ±β cat_Par Ξ±"
proof(intro wide_subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
interpret Par: category Ξ± βΉcat_Par Ξ±βΊ by (rule category_cat_Par)
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
interpret wide_subsemicategory Ξ± βΉsmc_Set Ξ±βΊ βΉsmc_Par Ξ±βΊ
by (simp add: wide_subsemicategory_smc_Set_smc_Par)
show "cat_Set Ξ± ββ©CβΞ±β cat_Par Ξ±"
proof(intro subcategoryI, unfold cat_smc_cat_Par cat_smc_cat_Set)
show "smc_Set Ξ± ββ©Sβ©Mβ©CβΞ±β smc_Par Ξ±" by (simp add: subsemicategory_axioms)
fix A assume "A ββ©β cat_Set Ξ±β¦Objβ¦"
then show "cat_Set Ξ±β¦CIdβ¦β¦Aβ¦ = cat_Par Ξ±β¦CIdβ¦β¦Aβ¦"
unfolding cat_Set_components cat_Par_components by simp
qed
(
auto simp:
subsemicategory_axioms Par.category_axioms Set.category_axioms
)
qed (rule wide_subsemicategory_smc_Set_smc_Par)
show "cat_Set Ξ± ββ©Cβ©.β©rβ©eβ©pβΞ±β cat_Par Ξ±"
proof(intro replete_subcategoryI)
interpret wide_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_subcategory_cat_Set_cat_Par)
show "cat_Set Ξ± ββ©CβΞ±β cat_Par Ξ±" by (rule subcategory_axioms)
fix A B F assume "F : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
note arr_Par = cat_Par_is_arr_isomorphismD[OF this]
from arr_Par show "F : A β¦βcat_Set Ξ±β B"
by (intro cat_Set_is_arrI arr_Set_arr_ParI cat_Par_is_arrD[OF arr_Par(1)])
(auto simp: cat_Par_is_arrD(2))
qed
qed
subsubsectionβΉβΉSetβΊ is a subcategory of βΉSetβΊβΊ
lemma (in π΅) subcategory_cat_Set_cat_Set:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cat_Set Ξ± ββ©CβΞ²β cat_Set Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show ?thesis
proof(intro subcategoryI')
show "category Ξ² (cat_Set Ξ±)"
by (rule category.cat_category_if_ge_Limit, insert assms(2))
(cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)+
show "A ββ©β cat_Set Ξ²β¦Objβ¦" if "A ββ©β cat_Set Ξ±β¦Objβ¦" for A
using that
unfolding cat_Set_components(1)
by (meson assms(2) Vset_in_mono Ξ².Axiom_of_Extensionality(3))
show is_arr_if_is_arr:
"F : A β¦βcat_Set Ξ²β B" if "F : A β¦βcat_Set Ξ±β B" for A B F
proof-
note f = cat_Set_is_arrD[OF that]
interpret f: arr_Set Ξ± F by (rule f(1))
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI)
show "ββ©β (Fβ¦ArrValβ¦) ββ©β Fβ¦ArrCodβ¦"
by (auto simp: f.arr_Set_ArrVal_vrange)
show "Fβ¦ArrDomβ¦ ββ©β Vset Ξ²"
by (auto intro!: f.arr_Set_ArrDom_in_Vset Vset_in_mono assms(2))
show "Fβ¦ArrCodβ¦ ββ©β Vset Ξ²"
by (auto intro!: f.arr_Set_ArrCod_in_Vset Vset_in_mono assms(2))
qed
(
auto simp:
f f.arr_Set_ArrVal_vdomain f.vfsequence_axioms f.arr_Set_length
)
qed
show "G ββ©Aβcat_Set Ξ±β F = G ββ©Aβcat_Set Ξ²β F"
if "G : B β¦βcat_Set Ξ±β C" and "F : A β¦βcat_Set Ξ±β B" for B C G A F
proof-
note g = cat_Set_is_arrD[OF that(1)] and f = cat_Set_is_arrD[OF that(2)]
from that have Ξ±_gf_is_arr: "G ββ©Aβcat_Set Ξ±β F : A β¦βcat_Set Ξ²β C"
by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
from that have Ξ²_gf_is_arr: "G ββ©Aβcat_Set Ξ²β F : A β¦βcat_Set Ξ²β C"
by (cs_concl cs_intro: cat_cs_intros is_arr_if_is_arr)
note Ξ±_gf = cat_Set_is_arrD[OF Ξ±_gf_is_arr]
and Ξ²_gf = cat_Set_is_arrD[OF Ξ²_gf_is_arr]
show ?thesis
proof(rule arr_Set_eqI)
show "arr_Set Ξ² (G ββ©Aβcat_Set Ξ±β F)" by (rule Ξ±_gf(1))
then interpret arr_Set_Ξ±_gf: arr_Set Ξ² βΉ(G ββ©Aβcat_Set Ξ±β F)βΊ by simp
from Ξ±_gf_is_arr have dom_lhs: "πβ©β ((G ββ©Aβcat_Set Ξ±β F)β¦ArrValβ¦) = A"
by (cs_concl cs_simp: cat_cs_simps)
show "arr_Set Ξ² (G ββ©Aβcat_Set Ξ²β F)" by (rule Ξ²_gf(1))
then interpret arr_Set_Ξ²_gf: arr_Set Ξ² βΉ(G ββ©Aβcat_Set Ξ²β F)βΊ by simp
from Ξ²_gf_is_arr have dom_rhs: "πβ©β ((G ββ©Aβcat_Set Ξ²β F)β¦ArrValβ¦) = A"
by (cs_concl cs_simp: cat_cs_simps)
show "(G ββ©Aβcat_Set Ξ±β F)β¦ArrValβ¦ = (G ββ©Aβcat_Set Ξ²β F)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β A"
from that this show
"(G ββ©Aβcat_Set Ξ±β F)β¦ArrValβ¦β¦aβ¦ = (G ββ©Aβcat_Set Ξ²β F)β¦ArrValβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros is_arr_if_is_arr
)
qed auto
qed (use Ξ±_gf_is_arr Ξ²_gf_is_arr in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
qed
(
auto simp:
assms(2) cat_Set_components Vset_trans Vset_in_mono cat_cs_intros
)
qed
subsectionβΉIsomorphismβΊ
lemma cat_Set_is_arr_isomorphismI[intro]:
assumes "T : A β¦βcat_Set Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
shows "T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
proof-
interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF assms(1)])
note [cat_cs_intros] = cat_Par_is_arr_isomorphismI
from wide_replete_subcategory_cat_Set_cat_Par assms have
"T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
by (cs_concl cs_intro: cat_cs_intros cat_sub_cs_intros cat_sub_fw_cs_intros)
with wide_replete_subcategory_cat_Set_cat_Par assms show
"T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
by (cs_concl cs_simp: cat_sub_bw_cs_simps)
qed
lemma cat_Set_is_arr_isomorphismD[dest]:
assumes "T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
shows "T : A β¦βcat_Set Ξ±β B"
and "v11 (Tβ¦ArrValβ¦)"
and "πβ©β (Tβ¦ArrValβ¦) = A"
and "ββ©β (Tβ¦ArrValβ¦) = B"
proof-
from assms have T: "T : A β¦βcat_Set Ξ±β B" by auto
interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
from wide_replete_subcategory_cat_Set_cat_Par assms have T:
"T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
show "v11 (Tβ¦ArrValβ¦)" "πβ©β (Tβ¦ArrValβ¦) = A" "ββ©β (Tβ¦ArrValβ¦) = B"
by (intro cat_Par_is_arr_isomorphismD[OF T])+
qed (rule is_arr_isomorphismD(1)[OF assms])
lemma cat_Set_is_arr_isomorphism:
"T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B β·
T : A β¦βcat_Set Ξ±β B β§
v11 (Tβ¦ArrValβ¦) β§
πβ©β (Tβ¦ArrValβ¦) = A β§
ββ©β (Tβ¦ArrValβ¦) = B"
by auto
subsectionβΉThe inverse arrowβΊ
lemma cat_Set_ArrVal_app_is_arr[cat_cs_intros]:
assumes "f : a β¦βπβ b"
and "category Ξ± π"
and "F : Hom π a b β¦βcat_Set Ξ±β Hom π
c d"
shows "Fβ¦ArrValβ¦β¦fβ¦ : c β¦βπ
β d"
proof-
interpret π: category Ξ± π by (rule assms(2))
interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF assms(3)])
from assms have "Fβ¦ArrValβ¦β¦fβ¦ ββ©β Hom π
c d"
by (cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros)
then show ?thesis unfolding in_Hom_iff by simp
qed
abbreviation (input) converse_Set :: "V β V" ("(_Β―β©Sβ©eβ©t)" [1000] 999)
where "aΒ―β©Sβ©eβ©t β‘ aΒ―β©Rβ©eβ©l"
lemma cat_Set_the_inverse[cat_Set_cs_simps]:
assumes "T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
shows "TΒ―β©Cβcat_Set Ξ±β = TΒ―β©Sβ©eβ©t"
proof-
from assms have T: "T : A β¦βcat_Set Ξ±β B" by auto
interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
from wide_replete_subcategory_cat_Set_cat_Par assms have T:
"T : A β¦β©iβ©sβ©oβcat_Par Ξ±β B"
by (cs_concl cs_intro: cat_sub_cs_intros cat_sub_fw_cs_intros)
from wide_replete_subcategory_cat_Set_cat_Par assms have [cat_cs_simps]:
"TΒ―β©Cβcat_Set Ξ±β = TΒ―β©Cβcat_Par Ξ±β"
by
(
cs_concl cs_full
cs_simp: cat_sub_bw_cs_simps cs_intro: cat_sub_cs_intros
)
from T show "TΒ―β©Cβcat_Set Ξ±β = TΒ―β©Rβ©eβ©l"
by (cs_concl cs_simp: cat_Par_cs_simps cat_cs_simps cs_intro: π΅_Ξ²)
qed
lemma cat_Set_the_inverse_app[cat_cs_intros]:
assumes "T : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
and "a ββ©β A"
and [cat_cs_simps]: "Tβ¦ArrValβ¦β¦aβ¦ = b"
shows "(TΒ―β©Cβcat_Set Ξ±β)β¦ArrValβ¦β¦bβ¦ = a"
proof-
from assms have T: "T : A β¦βcat_Set Ξ±β B" by auto
interpret arr_Set Ξ± T by (rule cat_Set_is_arrD(1)[OF T])
note T = cat_Set_is_arr_isomorphismD[OF assms(1)]
interpret T: v11 βΉTβ¦ArrValβ¦βΊ by (rule T(2))
from T.v11_axioms assms(1,2) show "TΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦bβ¦ = a"
by
(
cs_concl
cs_simp:
converse_Rel_components V_cs_simps cat_Set_cs_simps cat_cs_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros
)
qed
lemma cat_Set_ArrVal_app_the_inverse_is_arr[cat_cs_intros]:
assumes "f : c β¦βπ
β d"
and "category Ξ± π
"
and "F : Hom π a b β¦β©iβ©sβ©oβcat_Set Ξ±β Hom π
c d"
shows "FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦fβ¦ : a β¦βπβ b"
proof-
interpret π
: category Ξ± π
by (rule assms(2))
from cat_Set_is_arr_isomorphismD[OF assms(3)] interpret F: arr_Set Ξ± F
by (simp add: cat_Set_is_arrD)
from assms have "FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦fβ¦ ββ©β Hom π a b"
by (cs_concl cs_intro: cat_cs_intros cat_arrow_cs_intros)
then show ?thesis unfolding in_Hom_iff by simp
qed
lemma cat_Set_app_the_inverse_app[cat_cs_simps]:
assumes "F : A β¦β©iβ©sβ©oβcat_Set Ξ±β B" and "b ββ©β B"
shows "Fβ¦ArrValβ¦β¦FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦bβ¦β¦ = b"
proof-
note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
note F = F cat_Set_is_arrD[OF F(1)]
interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF F(1)])
from assms have [cat_cs_simps]:
"F ββ©Aβcat_Set Ξ±β FΒ―β©Cβcat_Set Ξ±β = cat_Set Ξ±β¦CIdβ¦β¦Bβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have [cat_cs_simps]:
"Fβ¦ArrValβ¦β¦FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦bβ¦β¦ =
(F ββ©Aβcat_Set Ξ±β FΒ―β©Cβcat_Set Ξ±β)β¦ArrValβ¦β¦bβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
)
from assms F.arr_Par_ArrCod_in_Vset[unfolded F] show ?thesis
by (cs_concl cs_simp: cat_cs_simps)
qed
lemma cat_Set_the_inverse_app_app[cat_cs_simps]:
assumes "F : A β¦β©iβ©sβ©oβcat_Set Ξ±β B" and "a ββ©β A"
shows "FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦Fβ¦ArrValβ¦β¦aβ¦β¦ = a"
proof-
note F = cat_Set_is_arr_isomorphismD[OF assms(1)]
note F = F cat_Set_is_arrD[OF F(1)]
interpret F: arr_Set Ξ± F by (rule cat_Set_is_arrD[OF F(1)])
from assms have [cat_cs_simps]:
"FΒ―β©Cβcat_Set Ξ±β ββ©Aβcat_Set Ξ±β F = cat_Set Ξ±β¦CIdβ¦β¦Aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have [cat_cs_simps]:
"FΒ―β©Cβcat_Set Ξ±ββ¦ArrValβ¦β¦Fβ¦ArrValβ¦β¦aβ¦β¦ =
(FΒ―β©Cβcat_Set Ξ±β ββ©Aβcat_Set Ξ±β F)β¦ArrValβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_arrow_cs_intros cat_cs_intros
)
from assms F.arr_Par_ArrDom_in_Vset[unfolded F] show ?thesis
by (cs_concl cs_simp: cat_cs_simps)
qed
subsectionβΉProjection arrows for βΉvtimesβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition vfst_arrow :: "V β V β V"
where "vfst_arrow A B = [(Ξ»abββ©βA Γβ©β B. vfst ab), A Γβ©β B, A]β©β"
definition vsnd_arrow :: "V β V β V"
where "vsnd_arrow A B = [(Ξ»abββ©βA Γβ©β B. vsnd ab), A Γβ©β B, B]β©β"
textβΉComponents.βΊ
lemma vfst_arrow_components:
shows "vfst_arrow A Bβ¦ArrValβ¦ = (Ξ»abββ©βA Γβ©β B. vfst ab)"
and [cat_cs_simps]: "vfst_arrow A Bβ¦ArrDomβ¦ = A Γβ©β B"
and [cat_cs_simps]: "vfst_arrow A Bβ¦ArrCodβ¦ = A"
unfolding vfst_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
lemma vsnd_arrow_components:
shows "vsnd_arrow A Bβ¦ArrValβ¦ = (Ξ»abββ©βA Γβ©β B. vsnd ab)"
and [cat_cs_simps]: "vsnd_arrow A Bβ¦ArrDomβ¦ = A Γβ©β B"
and [cat_cs_simps]: "vsnd_arrow A Bβ¦ArrCodβ¦ = B"
unfolding vsnd_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda vfst_arrow_components(1)
|vsv vfst_arrow_ArrVal_vsv[cat_cs_intros]|
|vdomain vfst_arrow_ArrVal_vdomain[cat_cs_simps]|
|app vfst_arrow_ArrVal_app'|
mk_VLambda vsnd_arrow_components(1)
|vsv vsnd_arrow_ArrVal_vsv[cat_cs_intros]|
|vdomain vsnd_arrow_ArrVal_vdomain[cat_cs_simps]|
|app vsnd_arrow_ArrVal_app'|
lemma vfst_arrow_ArrVal_app[cat_cs_simps]:
assumes "ab = β¨a, bβ©" and "ab ββ©β A Γβ©β B"
shows "vfst_arrow A Bβ¦ArrValβ¦β¦abβ¦ = a"
using assms(2) unfolding assms(1) by (simp add: vfst_arrow_ArrVal_app')
lemma vfst_arrow_vrange: "ββ©β (vfst_arrow A Bβ¦ArrValβ¦) ββ©β A"
unfolding vfst_arrow_components
proof(intro vrange_VLambda_vsubset)
fix ab assume "ab ββ©β A Γβ©β B"
then obtain a b where ab_def: "ab = β¨a, bβ©" and a: "a ββ©β A" by clarsimp
from a show "vfst ab ββ©β A" unfolding ab_def by simp
qed
lemma vsnd_arrow_ArrVal_app[cat_cs_simps]:
assumes "ab = β¨a, bβ©" and "ab ββ©β A Γβ©β B"
shows "vsnd_arrow A Bβ¦ArrValβ¦β¦abβ¦ = b"
using assms(2) unfolding assms(1) by (simp add: vsnd_arrow_ArrVal_app')
lemma vsnd_arrow_vrange: "ββ©β (vsnd_arrow A Bβ¦ArrValβ¦) ββ©β B"
unfolding vsnd_arrow_components
proof(intro vrange_VLambda_vsubset)
fix ab assume "ab ββ©β A Γβ©β B"
then obtain a b where ab_def: "ab = β¨a, bβ©" and b: "b ββ©β B" by clarsimp
from b show "vsnd ab ββ©β B" unfolding ab_def by simp
qed
subsubsectionβΉProjection arrows are arrows in the category βΉSetβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Set_arr_Vset:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±"
shows "vfst_arrow A B : A Γβ©β B β¦βcat_Set Ξ±β A"
proof(intro cat_Set_is_arrI arr_SetI, unfold cat_cs_simps)
show "vfsequence (vfst_arrow A B)" unfolding vfst_arrow_def by simp
show "vcard (vfst_arrow A B) = 3β©β"
unfolding vfst_arrow_def by (simp add: nat_omega_simps)
show "ββ©β (vfst_arrow A Bβ¦ArrValβ¦) ββ©β A" by (rule vfst_arrow_vrange)
qed (use assms in βΉcs_concl cs_intro: V_cs_intros cat_cs_introsβΊ)+
lemma (in π΅) vfst_arrow_is_cat_Set_arr:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦" and "B ββ©β cat_Set Ξ±β¦Objβ¦"
shows "vfst_arrow A B : A Γβ©β B β¦βcat_Set Ξ±β A"
using assms
unfolding cat_Set_components
by (rule vfst_arrow_is_cat_Set_arr_Vset)
lemma (in π΅) vfst_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "A' = A"
and "β' = cat_Set Ξ±"
shows "vfst_arrow A B : AB β¦ββ'β A'"
using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Set_arr)
lemmas [cat_rel_par_Set_cs_intros] = π΅.vfst_arrow_is_cat_Set_arr'
lemma (in π΅) vsnd_arrow_is_cat_Set_arr_Vset:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±"
shows "vsnd_arrow A B : A Γβ©β B β¦βcat_Set Ξ±β B"
proof(intro cat_Set_is_arrI arr_SetI , unfold cat_cs_simps)
show "vfsequence (vsnd_arrow A B)" unfolding vsnd_arrow_def by simp
show "vcard (vsnd_arrow A B) = 3β©β"
unfolding vsnd_arrow_def by (simp add: nat_omega_simps)
show "ββ©β (vsnd_arrow A Bβ¦ArrValβ¦) ββ©β B" by (rule vsnd_arrow_vrange)
qed (use assms in βΉcs_concl cs_intro: V_cs_intros cat_cs_introsβΊ)+
lemma (in π΅) vsnd_arrow_is_cat_Set_arr:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦" and "B ββ©β cat_Set Ξ±β¦Objβ¦"
shows "vsnd_arrow A B : A Γβ©β B β¦βcat_Set Ξ±β B"
using assms
unfolding cat_Set_components
by (rule vsnd_arrow_is_cat_Set_arr_Vset)
lemma (in π΅) vsnd_arrow_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "B' = B"
and "β' = cat_Set Ξ±"
shows "vsnd_arrow A B : AB β¦ββ'β B'"
using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Set_arr)
lemmas [cat_rel_par_Set_cs_intros] = π΅.vsnd_arrow_is_cat_Set_arr'
subsubsectionβΉProjection arrows are arrows in the category βΉParβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Par_arr:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦" and "B ββ©β cat_Par Ξ±β¦Objβ¦"
shows "vfst_arrow A B : A Γβ©β B β¦βcat_Par Ξ±β A"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
from assms show ?thesis
unfolding cat_Par_components(1)
by (intro Set_Par.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) vfst_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "A' = A"
and "β' = cat_Par Ξ±"
shows "vfst_arrow A B : AB β¦ββ'β A'"
using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Par_arr)
lemmas [cat_rel_Par_set_cs_intros] = π΅.vfst_arrow_is_cat_Par_arr'
lemma (in π΅) vsnd_arrow_is_cat_Par_arr:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦" and "B ββ©β cat_Par Ξ±β¦Objβ¦"
shows "vsnd_arrow A B : A Γβ©β B β¦βcat_Par Ξ±β B"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
from assms show ?thesis
unfolding cat_Par_components(1)
by (intro Set_Par.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) vsnd_arrow_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "B' = B"
and "β' = cat_Par Ξ±"
shows "vsnd_arrow A B : AB β¦ββ'β B'"
using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Par_arr)
lemmas [cat_rel_Par_set_cs_intros] = π΅.vsnd_arrow_is_cat_Par_arr'
subsubsectionβΉProjection arrows are arrows in the category βΉRelβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Rel_arr:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦" and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "vfst_arrow A B : A Γβ©β B β¦βcat_Rel Ξ±β A"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule subcat_trans[
OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
]
)
from assms show ?thesis
unfolding cat_Rel_components(1)
by (intro Set_Rel.subcat_is_arrD vfst_arrow_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) vfst_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "A' = A"
and "β' = cat_Rel Ξ±"
shows "vfst_arrow A B : AB β¦ββ'β A'"
using assms(1-2) unfolding assms(3-5) by (rule vfst_arrow_is_cat_Rel_arr)
lemmas [cat_Rel_par_set_cs_intros] = π΅.vfst_arrow_is_cat_Rel_arr'
lemma (in π΅) vsnd_arrow_is_cat_Rel_arr:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦" and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "vsnd_arrow A B : A Γβ©β B β¦βcat_Rel Ξ±β B"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule subcat_trans[
OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
]
)
from assms show ?thesis
unfolding cat_Rel_components(1)
by (intro Set_Rel.subcat_is_arrD vsnd_arrow_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) vsnd_arrow_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "AB = A Γβ©β B"
and "B' = B"
and "β' = cat_Rel Ξ±"
shows "vsnd_arrow A B : AB β¦ββ'β B'"
using assms(1-2) unfolding assms(3-5) by (rule vsnd_arrow_is_cat_Rel_arr)
lemmas [cat_Rel_par_set_cs_intros] = π΅.vsnd_arrow_is_cat_Rel_arr'
subsubsectionβΉProjection arrows are isomorphisms in the category βΉSetβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Set_arr_isomorphism_Vset:
assumes "A ββ©β Vset Ξ±" and "b ββ©β Vset Ξ±"
shows "vfst_arrow A (set {b}) : A Γβ©β set {b} β¦β©iβ©sβ©oβcat_Set Ξ±β A"
proof
(
intro
cat_Set_is_arr_isomorphismI
arr_SetI
vfst_arrow_is_cat_Set_arr_Vset
assms,
unfold cat_cs_simps
)
show "v11 (vfst_arrow A (set {b})β¦ArrValβ¦)"
proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
fix ab ab' assume prems:
"ab ββ©β A Γβ©β set {b}"
"ab' ββ©β A Γβ©β set {b}"
"vfst_arrow A (set {b})β¦ArrValβ¦β¦abβ¦ = vfst_arrow A (set {b})β¦ArrValβ¦β¦ab'β¦"
from prems obtain a where ab_def: "ab = β¨a, bβ©" and a: "a ββ©β A"
by clarsimp
from prems obtain a' where ab'_def: "ab' = β¨a', bβ©" and a': "a' ββ©β A"
by clarsimp
from prems(3) a a' have "a = a'"
unfolding ab_def ab'_def
by (cs_prems cs_simp: cat_cs_simps cs_intro: V_cs_intros)
then show "ab = ab'" unfolding ab_def ab'_def by simp
qed (cs_concl cs_intro: cat_cs_intros)
show "ββ©β (vfst_arrow A (set {b})β¦ArrValβ¦) = A"
proof(intro vsubset_antisym)
show "A ββ©β ββ©β (vfst_arrow A (set {b})β¦ArrValβ¦)"
proof(intro vsubsetI)
fix a assume a: "a ββ©β A"
then have a_def: "a = vfst_arrow A (set {b})β¦ArrValβ¦β¦β¨a, bβ©β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
from a assms show "a ββ©β ββ©β (vfst_arrow A (set {b})β¦ArrValβ¦)"
by (subst a_def, use nothing in βΉintro vsv.vsv_vimageI2βΊ)
(auto simp: cat_cs_simps cat_cs_intros)
qed
qed (rule vfst_arrow_vrange)
qed (use assms in auto)
lemma (in π΅) vfst_arrow_is_cat_Set_arr_isomorphism:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦" and "b ββ©β cat_Set Ξ±β¦Objβ¦"
shows "vfst_arrow A (set {b}) : A Γβ©β set {b} β¦β©iβ©sβ©oβcat_Set Ξ±β A"
using assms
unfolding cat_Set_components
by (rule vfst_arrow_is_cat_Set_arr_isomorphism_Vset)
lemma (in π΅) vfst_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "b ββ©β cat_Set Ξ±β¦Objβ¦"
and "AB = A Γβ©β set {b}"
and "A' = A"
and "β' = cat_Set Ξ±"
shows "vfst_arrow A (set {b}) : AB β¦β©iβ©sβ©oββ'β A"
using assms(1-2)
unfolding assms(3-5)
by (rule vfst_arrow_is_cat_Set_arr_isomorphism)
lemmas [cat_rel_par_Set_cs_intros] = π΅.vfst_arrow_is_cat_Set_arr_isomorphism'
lemma (in π΅) vsnd_arrow_is_cat_Set_arr_isomorphism_Vset:
assumes "a ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±"
shows "vsnd_arrow (set {a}) B : set {a} Γβ©β B β¦β©iβ©sβ©oβcat_Set Ξ±β B"
proof
(
intro
cat_Set_is_arr_isomorphismI
arr_SetI
vsnd_arrow_is_cat_Set_arr_Vset
assms,
unfold cat_cs_simps
)
show "v11 (vsnd_arrow (set {a}) Bβ¦ArrValβ¦)"
proof(rule vsv.vsv_valeq_v11I, unfold cat_cs_simps)
fix ab ab' assume prems:
"ab ββ©β set {a} Γβ©β B"
"ab' ββ©β set {a} Γβ©β B"
"vsnd_arrow (set {a}) Bβ¦ArrValβ¦β¦abβ¦ = vsnd_arrow (set {a}) Bβ¦ArrValβ¦β¦ab'β¦"
from prems obtain b where ab_def: "ab = β¨a, bβ©" and b: "b ββ©β B"
by clarsimp
from prems obtain b' where ab'_def: "ab' = β¨a, b'β©" and b': "b' ββ©β B"
by clarsimp
from prems(3) b b' have "b = b'"
unfolding ab_def ab'_def
by (cs_prems cs_simp: cat_cs_simps cs_intro: V_cs_intros)
then show "ab = ab'" unfolding ab_def ab'_def by simp
qed (cs_concl cs_intro: cat_cs_intros)
show "ββ©β (vsnd_arrow (set {a}) Bβ¦ArrValβ¦) = B"
proof(intro vsubset_antisym)
show "B ββ©β ββ©β (vsnd_arrow (set {a}) Bβ¦ArrValβ¦)"
proof(intro vsubsetI)
fix b assume b: "b ββ©β B"
then have b_def: "b = vsnd_arrow (set {a}) Bβ¦ArrValβ¦β¦β¨a, bβ©β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
from b assms show "b ββ©β ββ©β (vsnd_arrow (set {a}) Bβ¦ArrValβ¦)"
by (subst b_def, use nothing in βΉintro vsv.vsv_vimageI2βΊ)
(auto simp: cat_cs_simps cat_cs_intros)
qed
qed (rule vsnd_arrow_vrange)
qed (use assms in auto)
lemma (in π΅) vsnd_arrow_is_cat_Set_arr_isomorphism:
assumes "a ββ©β cat_Set Ξ±β¦Objβ¦" and "B ββ©β cat_Set Ξ±β¦Objβ¦"
shows "vsnd_arrow (set {a}) B : set {a} Γβ©β B β¦β©iβ©sβ©oβcat_Set Ξ±β B"
using assms
unfolding cat_Set_components
by (rule vsnd_arrow_is_cat_Set_arr_isomorphism_Vset)
lemma (in π΅) vsnd_arrow_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
assumes "a ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "AB = set {a} Γβ©β B"
and "A' = A"
and "β' = cat_Set Ξ±"
shows "vsnd_arrow (set {a}) B : AB β¦β©iβ©sβ©oββ'β B"
using assms(1-2)
unfolding assms(3-5)
by (rule vsnd_arrow_is_cat_Set_arr_isomorphism)
lemmas [cat_rel_par_Set_cs_intros] = π΅.vsnd_arrow_is_cat_Set_arr_isomorphism'
subsubsectionβΉProjection arrows are isomorphisms in the category βΉParβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Par_arr_isomorphism:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦" and "b ββ©β cat_Par Ξ±β¦Objβ¦"
shows "vfst_arrow A (set {b}) : A Γβ©β set {b} β¦β©iβ©sβ©oβcat_Par Ξ±β A"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
show "vfst_arrow A (set {b}) : A Γβ©β set {b} β¦β©iβ©sβ©oβcat_Par Ξ±β A"
by
(
rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Par_components]
]
]
)
qed
lemma (in π΅) vfst_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "b ββ©β cat_Par Ξ±β¦Objβ¦"
and "AB = A Γβ©β set {b}"
and "A' = A"
and "β' = cat_Par Ξ±"
shows "vfst_arrow A (set {b}) : AB β¦β©iβ©sβ©oββ'β A"
using assms(1-2)
unfolding assms(3-5)
by (rule vfst_arrow_is_cat_Par_arr_isomorphism)
lemmas [cat_rel_Par_set_cs_intros] = π΅.vfst_arrow_is_cat_Par_arr_isomorphism'
lemma (in π΅) vsnd_arrow_is_cat_Par_arr_isomorphism:
assumes "a ββ©β cat_Par Ξ±β¦Objβ¦" and "B ββ©β cat_Par Ξ±β¦Objβ¦"
shows "vsnd_arrow (set {a}) B : set {a} Γβ©β B β¦β©iβ©sβ©oβcat_Par Ξ±β B"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
show "vsnd_arrow (set {a}) B : set {a} Γβ©β B β¦β©iβ©sβ©oβcat_Par Ξ±β B"
by
(
rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Par_components]
]
]
)
qed
lemma (in π΅) vsnd_arrow_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
assumes "a ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "AB = set {a} Γβ©β B"
and "A' = A"
and "β' = cat_Par Ξ±"
shows "vsnd_arrow (set {a}) B : AB β¦β©iβ©sβ©oββ'β B"
using assms(1-2)
unfolding assms(3-5)
by (rule vsnd_arrow_is_cat_Par_arr_isomorphism)
lemmas [cat_rel_Par_set_cs_intros] = π΅.vsnd_arrow_is_cat_Par_arr_isomorphism'
subsubsectionβΉProjection arrows are isomorphisms in the category βΉRelβΊβΊ
lemma (in π΅) vfst_arrow_is_cat_Rel_arr_isomorphism:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦" and "b ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "vfst_arrow A (set {b}) : A Γβ©β set {b} β¦β©iβ©sβ©oβcat_Rel Ξ±β A"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule wr_subcat_trans
[
OF
Set_Par.wide_replete_subcategory_axioms
Par_Rel.wide_replete_subcategory_axioms
]
)
show ?thesis
by
(
rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF vfst_arrow_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Rel_components]
]
]
)
qed
lemma (in π΅) vfst_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "b ββ©β cat_Rel Ξ±β¦Objβ¦"
and "AB = A Γβ©β set {b}"
and "A' = A"
and "β' = cat_Rel Ξ±"
shows "vfst_arrow A (set {b}) : AB β¦β©iβ©sβ©oββ'β A"
using assms(1-2)
unfolding assms(3-5)
by (rule vfst_arrow_is_cat_Rel_arr_isomorphism)
lemmas [cat_Rel_par_set_cs_intros] = π΅.vfst_arrow_is_cat_Rel_arr_isomorphism'
lemma (in π΅) vsnd_arrow_is_cat_Rel_arr_isomorphism:
assumes "a ββ©β cat_Rel Ξ±β¦Objβ¦" and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "vsnd_arrow (set {a}) B : set {a} Γβ©β B β¦β©iβ©sβ©oβcat_Rel Ξ±β B"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule wr_subcat_trans
[
OF
Set_Par.wide_replete_subcategory_axioms
Par_Rel.wide_replete_subcategory_axioms
]
)
show ?thesis
by
(
rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF vsnd_arrow_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Rel_components]
]
]
)
qed
lemma (in π΅) vsnd_arrow_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
assumes "a ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "AB = set {a} Γβ©β B"
and "A' = A"
and "β' = cat_Rel Ξ±"
shows "vsnd_arrow (set {a}) B : AB β¦β©iβ©sβ©oββ'β B"
using assms(1-2)
unfolding assms(3-5)
by (rule vsnd_arrow_is_cat_Rel_arr_isomorphism)
lemmas [cat_Rel_par_set_cs_intros] = π΅.vsnd_arrow_is_cat_Rel_arr_isomorphism'
subsectionβΉProjection arrow for βΉvproductβΊβΊ
definition vprojection_arrow :: "V β (V β V) β V β V"
where "vprojection_arrow I A i = [vprojection I A i, (ββ©βiββ©βI. A i), A i]β©β"
textβΉComponents.βΊ
lemma vprojection_arrow_components:
shows "vprojection_arrow I A iβ¦ArrValβ¦ = vprojection I A i"
and "vprojection_arrow I A iβ¦ArrDomβ¦ = (ββ©βiββ©βI. A i)"
and "vprojection_arrow I A iβ¦ArrCodβ¦ = A i"
unfolding vprojection_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉProjection arrow valueβΊ
mk_VLambda vprojection_arrow_components(1)[unfolded vprojection_def]
|vsv vprojection_arrow_vsv[cat_Set_cs_intros]|
|vdomain vprojection_arrow_vdomain[cat_Set_cs_simps]|
|app vprojection_arrow_app[cat_Set_cs_simps]|
subsubsectionβΉProjection arrow is an arrow in the category βΉSetβΊβΊ
lemma (in π΅) arr_Set_vprojection_arrow:
assumes "i ββ©β I" and "VLambda I A ββ©β Vset Ξ±"
shows "arr_Set Ξ± (vprojection_arrow I A i)"
proof(intro arr_SetI)
show "vfsequence (vprojection_arrow I A i)"
unfolding vprojection_arrow_def by auto
show "vcard (vprojection_arrow I A i) = 3β©β"
unfolding vprojection_arrow_def by (simp add: nat_omega_simps)
show "vprojection_arrow I A iβ¦ArrCodβ¦ ββ©β Vset Ξ±"
unfolding vprojection_arrow_components
proof-
from assms(1) have "i ββ©β I" by simp
then have "A i ββ©β ββ©β (VLambda I A)" by auto
moreover from assms(2) have "ββ©β (VLambda I A) ββ©β Vset Ξ±"
by (meson vrange_in_VsetI)
ultimately show "A i ββ©β Vset Ξ±" by auto
qed
qed
(
auto
simp: vprojection_arrow_components
intro!:
assms
vprojection_vrange_vsubset
Limit_vproduct_in_Vset_if_VLambda_in_VsetI
)
lemma (in π΅) vprojection_arrow_is_arr:
assumes "i ββ©β I" and "VLambda I A ββ©β Vset Ξ±"
shows "vprojection_arrow I A i : (ββ©βiββ©βI. A i) β¦βcat_Set Ξ±β A i"
proof(intro cat_Set_is_arrI)
from assms show "arr_Set Ξ± (vprojection_arrow I A i)"
by (rule arr_Set_vprojection_arrow)
qed (simp_all add: vprojection_arrow_components)
subsectionβΉProduct arrow value for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition prod_2_Rel_ArrVal :: "V β V β V"
where "prod_2_Rel_ArrVal S T =
set {β¨β¨a, bβ©, β¨c, dβ©β© | a b c d. β¨a, cβ© ββ©β S β§ β¨b, dβ© ββ©β T}"
lemma small_prod_2_Rel_ArrVal[simp]:
"small {β¨β¨a, bβ©, β¨c, dβ©β© | a b c d. β¨a, cβ© ββ©β S β§ β¨b, dβ© ββ©β T}"
(is βΉsmall ?SβΊ)
proof(rule down)
show "?S β elts ((πβ©β S Γβ©β πβ©β T) Γβ©β (ββ©β S Γβ©β ββ©β T))" by auto
qed
textβΉRules.βΊ
lemma prod_2_Rel_ArrValI:
assumes "ab_cd = β¨β¨a, bβ©, β¨c, dβ©β©"
and "β¨a, cβ© ββ©β S"
and "β¨b, dβ© ββ©β T"
shows "ab_cd ββ©β prod_2_Rel_ArrVal S T"
using assms unfolding prod_2_Rel_ArrVal_def by simp
lemma prod_2_Rel_ArrValD[dest]:
assumes "β¨β¨a, bβ©, β¨c, dβ©β© ββ©β prod_2_Rel_ArrVal S T"
shows "β¨a, cβ© ββ©β S" and "β¨b, dβ© ββ©β T"
using assms unfolding prod_2_Rel_ArrVal_def by auto
lemma prod_2_Rel_ArrValE[elim]:
assumes "ab_cd ββ©β prod_2_Rel_ArrVal S T"
obtains a b c d where "ab_cd = β¨β¨a, bβ©, β¨c, dβ©β©"
and "β¨a, cβ© ββ©β S"
and "β¨b, dβ© ββ©β T"
using assms unfolding prod_2_Rel_ArrVal_def by auto
textβΉElementary propertiesβΊ
lemma prod_2_Rel_ArrVal_vsubset_vprod:
"prod_2_Rel_ArrVal S T ββ©β ((πβ©β S Γβ©β πβ©β T) Γβ©β (ββ©β S Γβ©β ββ©β T))"
by auto
lemma prod_2_Rel_ArrVal_vbrelation: "vbrelation (prod_2_Rel_ArrVal S T)"
using prod_2_Rel_ArrVal_vsubset_vprod by auto
lemma prod_2_Rel_ArrVal_vdomain: "πβ©β (prod_2_Rel_ArrVal S T) = πβ©β S Γβ©β πβ©β T"
proof(intro vsubset_antisym)
show "πβ©β S Γβ©β πβ©β T ββ©β πβ©β (prod_2_Rel_ArrVal S T)"
proof(intro vsubsetI)
fix ab assume "ab ββ©β πβ©β S Γβ©β πβ©β T"
then obtain a b
where ab_def: "ab = β¨a, bβ©"
and "a ββ©β πβ©β S"
and "b ββ©β πβ©β T"
by auto
then obtain c d where "β¨a, cβ© ββ©β S" and "β¨b, dβ© ββ©β T" by force
then have "β¨β¨a, bβ©, β¨c, dβ©β© ββ©β prod_2_Rel_ArrVal S T"
by (intro prod_2_Rel_ArrValI) auto
then show "ab ββ©β πβ©β (prod_2_Rel_ArrVal S T)"
unfolding ab_def by auto
qed
qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)
lemma prod_2_Rel_ArrVal_vrange: "ββ©β (prod_2_Rel_ArrVal S T) = ββ©β S Γβ©β ββ©β T"
proof(intro vsubset_antisym)
show "ββ©β S Γβ©β ββ©β T ββ©β ββ©β (prod_2_Rel_ArrVal S T)"
proof(intro vsubsetI)
fix cd assume "cd ββ©β ββ©β S Γβ©β ββ©β T"
then obtain c d
where cd_def: "cd = β¨c, dβ©"
and "c ββ©β ββ©β S"
and "d ββ©β ββ©β T"
by auto
then obtain a b where "β¨a, cβ© ββ©β S" and "β¨b, dβ© ββ©β T" by force
then have "β¨β¨a, bβ©, β¨c, dβ©β© ββ©β prod_2_Rel_ArrVal S T"
by (intro prod_2_Rel_ArrValI) auto
then show "cd ββ©β ββ©β (prod_2_Rel_ArrVal S T)"
unfolding cd_def by auto
qed
qed (use prod_2_Rel_ArrVal_vsubset_vprod in blast)
subsubsectionβΉFurther propertiesβΊ
lemma
assumes "vsv g" and "vsv f"
shows prod_2_Rel_ArrVal_vsv: "vsv (prod_2_Rel_ArrVal g f)"
and prod_2_Rel_ArrVal_app:
"βa b. β¦ a ββ©β πβ©β g; b ββ©β πβ©β f β§ βΉ
prod_2_Rel_ArrVal g fβ¦β¨a,bβ©β¦ = β¨gβ¦aβ¦, fβ¦bβ¦β©"
proof-
interpret g: vsv g by (rule assms(1))
interpret f: vsv f by (rule assms(2))
show vsv_gf: "vsv (prod_2_Rel_ArrVal g f)"
by (intro vsvI; (elim prod_2_Rel_ArrValE)?; (unfold prod_2_Rel_ArrVal_def)?)
(auto simp: g.vsv f.vsv)
fix a b assume "a ββ©β πβ©β g" "b ββ©β πβ©β f"
then have a_ga: "β¨a, gβ¦aβ¦β© ββ©β g" and b_fb: "β¨b, fβ¦bβ¦β© ββ©β f" by auto
from a_ga b_fb show "prod_2_Rel_ArrVal g fβ¦β¨a, bβ©β¦ = β¨gβ¦aβ¦, fβ¦bβ¦β©"
by (cs_concl cs_simp: vsv.vsv_appI[OF vsv_gf] cs_intro: prod_2_Rel_ArrValI)
qed
lemma prod_2_Rel_ArrVal_v11:
assumes "v11 g" and "v11 f"
shows "v11 (prod_2_Rel_ArrVal g f)"
proof-
interpret g: v11 g by (rule assms(1))
interpret f: v11 f by (rule assms(2))
show ?thesis
proof
(
intro vsv.vsv_valeq_v11I prod_2_Rel_ArrVal_vsv g.vsv_axioms f.vsv_axioms,
unfold prod_2_Rel_ArrVal_vdomain
)
fix ab cd
assume prems:
"ab ββ©β πβ©β g Γβ©β πβ©β f"
"cd ββ©β πβ©β g Γβ©β πβ©β f"
"prod_2_Rel_ArrVal g fβ¦abβ¦ = prod_2_Rel_ArrVal g fβ¦cdβ¦"
from prems(1) obtain a b
where ab_def: "ab = β¨a, bβ©" and a: "a ββ©β πβ©β g" and b: "b ββ©β πβ©β f"
by auto
from prems(2) obtain c d
where cd_def: "cd = β¨c, dβ©" and c: "c ββ©β πβ©β g" and d: "d ββ©β πβ©β f"
by auto
from prems(3) a b c d have "β¨gβ¦aβ¦, fβ¦bβ¦β© = β¨gβ¦cβ¦, fβ¦dβ¦β©"
unfolding ab_def cd_def
by (cs_prems cs_simp: prod_2_Rel_ArrVal_app cs_intro: V_cs_intros)
then have "gβ¦aβ¦ = gβ¦cβ¦" and "fβ¦bβ¦ = fβ¦dβ¦" by simp_all
then show "ab = cd"
by (auto simp: ab_def cd_def a b c d f.v11_injective g.v11_injective)
qed
qed
lemma prod_2_Rel_ArrVal_vcomp:
"prod_2_Rel_ArrVal S' T' ββ©β prod_2_Rel_ArrVal S T =
prod_2_Rel_ArrVal (S' ββ©β S) (T' ββ©β T)"
proof-
interpret ST': vbrelation βΉprod_2_Rel_ArrVal S' T'βΊ
by (rule prod_2_Rel_ArrVal_vbrelation)
interpret ST: vbrelation βΉprod_2_Rel_ArrVal S TβΊ
by (rule prod_2_Rel_ArrVal_vbrelation)
show ?thesis
proof(intro vsubset_antisym vsubsetI)
fix aa'_cc' assume
"aa'_cc' ββ©β prod_2_Rel_ArrVal S' T' ββ©β prod_2_Rel_ArrVal S T"
then obtain aa' bb' cc' where ac_def: "aa'_cc' = β¨aa', cc'β©"
and bc: "β¨bb', cc'β© ββ©β prod_2_Rel_ArrVal S' T'"
and ab: "β¨aa', bb'β© ββ©β prod_2_Rel_ArrVal S T"
by auto
from bc obtain b b' c c'
where bb'_cc'_def: "β¨bb', cc'β© = β¨β¨b, b'β©, β¨c, c'β©β©"
and bc: "β¨b, cβ© ββ©β S'"
and bc': "β¨b', c'β© ββ©β T'"
by auto
with ab obtain a a'
where aa'_bb'_def: "β¨aa', bb'β© = β¨β¨a, a'β©, β¨b, b'β©β©"
and ab: "β¨a, bβ© ββ©β S"
and ab': "β¨a', b'β© ββ©β T"
by auto
from bb'_cc'_def have bb'_def: "bb' = β¨b, b'β©" and cc'_def: "cc' = β¨c, c'β©"
by simp_all
from aa'_bb'_def have aa'_def: "aa' = β¨a, a'β©" and bb'_def: "bb' = β¨b, b'β©"
by simp_all
from bc bc' ab ab' show "aa'_cc' ββ©β prod_2_Rel_ArrVal (S' ββ©β S) (T' ββ©β T)"
unfolding ac_def aa'_def cc'_def
by (intro prod_2_Rel_ArrValI)
(cs_concl cs_intro: prod_2_Rel_ArrValI vcompI)+
next
fix aa'_cc' assume "aa'_cc' ββ©β prod_2_Rel_ArrVal (S' ββ©β S) (T' ββ©β T)"
then obtain a a' c c'
where aa'_cc'_def: "aa'_cc' = β¨β¨a, a'β©, β¨c, c'β©β©"
and ac: "β¨a, cβ© ββ©β S' ββ©β S"
and ac': "β¨a', c'β© ββ©β T' ββ©β T"
by blast
from ac obtain b where ab: "β¨a, bβ© ββ©β S" and bc: "β¨b, cβ© ββ©β S'"
by auto
from ac' obtain b' where ab': "β¨a', b'β© ββ©β T" and bc': "β¨b', c'β© ββ©β T'"
by auto
from ab bc ab' bc' show
"aa'_cc' ββ©β prod_2_Rel_ArrVal S' T' ββ©β prod_2_Rel_ArrVal S T"
unfolding aa'_cc'_def by (cs_concl cs_intro: vcompI prod_2_Rel_ArrValI)
qed
qed
lemma prod_2_Rel_ArrVal_vid_on[cat_cs_simps]:
"prod_2_Rel_ArrVal (vid_on A) (vid_on B) = vid_on (A Γβ©β B)"
unfolding prod_2_Rel_ArrVal_def by auto
subsectionβΉProduct arrow for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition prod_2_Rel :: "V β V β V"
where "prod_2_Rel S T =
[
prod_2_Rel_ArrVal (Sβ¦ArrValβ¦) (Tβ¦ArrValβ¦),
Sβ¦ArrDomβ¦ Γβ©β Tβ¦ArrDomβ¦,
Sβ¦ArrCodβ¦ Γβ©β Tβ¦ArrCodβ¦
]β©β"
textβΉComponents.βΊ
lemma prod_2_Rel_components:
shows "prod_2_Rel S Tβ¦ArrValβ¦ = prod_2_Rel_ArrVal (Sβ¦ArrValβ¦) (Tβ¦ArrValβ¦)"
and [cat_cs_simps]: "prod_2_Rel S Tβ¦ArrDomβ¦ = Sβ¦ArrDomβ¦ Γβ©β Tβ¦ArrDomβ¦"
and [cat_cs_simps]: "prod_2_Rel S Tβ¦ArrCodβ¦ = Sβ¦ArrCodβ¦ Γβ©β Tβ¦ArrCodβ¦"
unfolding prod_2_Rel_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉProduct arrow for βΉRelβΊ is an arrow in βΉRelβΊβΊ
lemma prod_2_Rel_is_cat_Rel_arr:
assumes "S : A β¦βcat_Rel Ξ±β B" and "T : C β¦βcat_Rel Ξ±β D"
shows "prod_2_Rel S T : A Γβ©β C β¦βcat_Rel Ξ±β B Γβ©β D"
proof-
note S = cat_Rel_is_arrD[OF assms(1)]
note T = cat_Rel_is_arrD[OF assms(2)]
interpret S: arr_Rel Ξ± S
rewrites [simp]: "Sβ¦ArrDomβ¦ = A" and [simp]: "Sβ¦ArrCodβ¦ = B"
by (simp_all add: S)
interpret T: arr_Rel Ξ± T
rewrites [simp]: "Tβ¦ArrDomβ¦ = C" and [simp]: "Tβ¦ArrCodβ¦ = D"
by (simp_all add: T)
show ?thesis
proof(intro cat_Rel_is_arrI arr_RelI)
show "vfsequence (prod_2_Rel S T)"
unfolding prod_2_Rel_def by simp
show "vcard (prod_2_Rel S T) = 3β©β"
unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
from S have "πβ©β (Sβ¦ArrValβ¦) ββ©β A" and "ββ©β (Sβ¦ArrValβ¦) ββ©β B" by auto
moreover from T have "πβ©β (Tβ¦ArrValβ¦) ββ©β C" and "ββ©β (Tβ¦ArrValβ¦) ββ©β D"
by auto
ultimately have
"πβ©β (Sβ¦ArrValβ¦) Γβ©β πβ©β (Tβ¦ArrValβ¦) ββ©β A Γβ©β C"
"ββ©β (Sβ¦ArrValβ¦) Γβ©β ββ©β (Tβ¦ArrValβ¦) ββ©β B Γβ©β D"
by auto
then show
"πβ©β (prod_2_Rel S Tβ¦ArrValβ¦) ββ©β prod_2_Rel S Tβ¦ArrDomβ¦"
"ββ©β (prod_2_Rel S Tβ¦ArrValβ¦) ββ©β prod_2_Rel S Tβ¦ArrCodβ¦"
unfolding
prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
by (force simp: prod_2_Rel_components)+
from
S.arr_Rel_ArrDom_in_Vset T.arr_Rel_ArrDom_in_Vset
S.arr_Rel_ArrCod_in_Vset T.arr_Rel_ArrCod_in_Vset
show "prod_2_Rel S Tβ¦ArrDomβ¦ ββ©β Vset Ξ±" "prod_2_Rel S Tβ¦ArrCodβ¦ ββ©β Vset Ξ±"
unfolding prod_2_Rel_components
by (allβΉintro Limit_vtimes_in_VsetIβΊ) auto
qed (auto simp: prod_2_Rel_components intro: prod_2_Rel_ArrVal_vbrelation)
qed
lemma prod_2_Rel_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
assumes "S : A β¦βcat_Rel Ξ±β B"
and "T : C β¦βcat_Rel Ξ±β D"
and "A' = A Γβ©β C"
and "B' = B Γβ©β D"
and "β' = cat_Rel Ξ±"
shows "prod_2_Rel S T : A' β¦ββ'β B'"
using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Rel_arr)
subsubsectionβΉProduct arrow for βΉRelβΊ is an arrow in βΉSetβΊβΊ
lemma prod_2_Rel_app[cat_rel_par_Set_cs_simps]:
assumes "S : A β¦βcat_Set Ξ±β B"
and "T : C β¦βcat_Set Ξ±β D"
and "a ββ©β A"
and "c ββ©β C"
and "ac = β¨a, cβ©"
shows "prod_2_Rel S Tβ¦ArrValβ¦β¦acβ¦ = β¨Sβ¦ArrValβ¦β¦aβ¦, Tβ¦ArrValβ¦β¦cβ¦β©"
proof-
note S = cat_Set_is_arrD[OF assms(1)]
note T = cat_Set_is_arrD[OF assms(2)]
interpret S: arr_Set Ξ± S
rewrites [simp]: "Sβ¦ArrDomβ¦ = A" and [simp]: "Sβ¦ArrCodβ¦ = B"
by (simp_all add: S)
interpret T: arr_Set Ξ± T
rewrites [simp]: "Tβ¦ArrDomβ¦ = C" and [simp]: "Tβ¦ArrCodβ¦ = D"
by (simp_all add: T)
from assms(3,4) show ?thesis
unfolding prod_2_Rel_components(1) assms(5)
by
(
cs_concl
cs_simp:
S.arr_Set_ArrVal_vdomain
T.arr_Set_ArrVal_vdomain
prod_2_Rel_ArrVal_app
cs_intro: V_cs_intros
)
qed
lemma prod_2_Rel_is_cat_Set_arr:
assumes "S : A β¦βcat_Set Ξ±β B" and "T : C β¦βcat_Set Ξ±β D"
shows "prod_2_Rel S T : A Γβ©β C β¦βcat_Set Ξ±β B Γβ©β D"
proof-
note S = cat_Set_is_arrD[OF assms(1)]
note T = cat_Set_is_arrD[OF assms(2)]
interpret S: arr_Set Ξ± S
rewrites [simp]: "Sβ¦ArrDomβ¦ = A" and [simp]: "Sβ¦ArrCodβ¦ = B"
by (simp_all add: S)
interpret T: arr_Set Ξ± T
rewrites [simp]: "Tβ¦ArrDomβ¦ = C" and [simp]: "Tβ¦ArrCodβ¦ = D"
by (simp_all add: T)
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (prod_2_Rel S T)"
unfolding prod_2_Rel_def by simp
show "vcard (prod_2_Rel S T) = 3β©β"
unfolding prod_2_Rel_def by (simp add: nat_omega_simps)
from S.arr_Set_ArrVal_vrange T.arr_Set_ArrVal_vrange show
"ββ©β (prod_2_Rel S Tβ¦ArrValβ¦) ββ©β prod_2_Rel S Tβ¦ArrCodβ¦"
unfolding
prod_2_Rel_components prod_2_Rel_ArrVal_vdomain prod_2_Rel_ArrVal_vrange
by auto
from assms S.arr_Par_ArrDom_in_Vset T.arr_Par_ArrDom_in_Vset show
"prod_2_Rel S Tβ¦ArrDomβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
from assms S.arr_Par_ArrCod_in_Vset T.arr_Par_ArrCod_in_Vset show
"prod_2_Rel S Tβ¦ArrCodβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
from assms show "prod_2_Rel S Tβ¦ArrDomβ¦ = A Γβ©β C"
by (cs_concl cs_simp: cat_cs_simps)
from assms show "prod_2_Rel S Tβ¦ArrCodβ¦ = B Γβ©β D"
by (cs_concl cs_simp: cat_cs_simps)
show "vsv (prod_2_Rel S Tβ¦ArrValβ¦)"
unfolding prod_2_Rel_components
by (intro prod_2_Rel_ArrVal_vsv S.ArrVal.vsv_axioms T.ArrVal.vsv_axioms)
qed
(
auto simp:
cat_cs_simps cat_Set_cs_simps
prod_2_Rel_ArrVal_vdomain prod_2_Rel_components(1)
)
qed
lemma prod_2_Rel_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "S : A β¦βcat_Set Ξ±β B"
and "T : C β¦βcat_Set Ξ±β D"
and "AC = A Γβ©β C"
and "BD = B Γβ©β D"
and "β' = cat_Set Ξ±"
shows "prod_2_Rel S T : AC β¦ββ'β BD"
using assms(1,2) unfolding assms(3-5) by (rule prod_2_Rel_is_cat_Set_arr)
subsubsectionβΉProduct arrow for βΉRelβΊ is an isomorphism in βΉSetβΊβΊ
lemma prod_2_Rel_is_cat_Set_arr_isomorphism:
assumes "S : A β¦β©iβ©sβ©oβcat_Set Ξ±β B" and "T : C β¦β©iβ©sβ©oβcat_Set Ξ±β D"
shows "prod_2_Rel S T : A Γβ©β C β¦β©iβ©sβ©oβcat_Set Ξ±β B Γβ©β D"
proof-
note S = cat_Set_is_arr_isomorphismD[OF assms(1)]
note T = cat_Set_is_arr_isomorphismD[OF assms(2)]
show ?thesis
proof
(
intro cat_Set_is_arr_isomorphismI prod_2_Rel_is_cat_Set_arr[OF S(1) T(1)],
unfold prod_2_Rel_components
)
show "πβ©β (prod_2_Rel_ArrVal (Sβ¦ArrValβ¦) (Tβ¦ArrValβ¦)) = A Γβ©β C"
unfolding prod_2_Rel_ArrVal_vdomain
by (cs_concl cs_simp: S(3) T(3) cs_intro: cat_cs_intros)
show "ββ©β (prod_2_Rel_ArrVal (Sβ¦ArrValβ¦) (Tβ¦ArrValβ¦)) = B Γβ©β D"
unfolding prod_2_Rel_ArrVal_vrange
by (cs_concl cs_simp: S(4) T(4) cs_intro: cat_cs_intros)
qed (use S(2) T(2) in βΉcs_concl cs_intro: prod_2_Rel_ArrVal_v11βΊ)
qed
lemma prod_2_Rel_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
assumes "S : A β¦β©iβ©sβ©oβcat_Set Ξ±β B"
and "T : C β¦β©iβ©sβ©oβcat_Set Ξ±β D"
and "AC = A Γβ©β C"
and "BD = B Γβ©β D"
and "β' = cat_Set Ξ±"
shows "prod_2_Rel S T : AC β¦β©iβ©sβ©oββ'β BD"
using assms(1,2)
unfolding assms(3-5)
by (rule prod_2_Rel_is_cat_Set_arr_isomorphism)
subsubsectionβΉFurther elementary propertiesβΊ
lemma prod_2_Rel_Comp:
assumes "G' : B' β¦βcat_Rel Ξ±β B''"
and "F' : A' β¦βcat_Rel Ξ±β A''"
and "G : B β¦βcat_Rel Ξ±β B'"
and "F : A β¦βcat_Rel Ξ±β A'"
shows
"prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F =
prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F)"
proof-
from cat_Rel_is_arrD(1)[OF assms(1)] interpret π΅ Ξ± by auto
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
note [cat_cs_simps] = cat_Rel_is_arrD(2,3)
from assms have GF'_GF:
"prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F :
B Γβ©β A β¦βcat_Rel Ξ±β B'' Γβ©β A''"
by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
from assms Rel.category_axioms have GG'_FF':
"prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F) :
B Γβ©β A β¦βcat_Rel Ξ±β B'' Γβ©β A''"
by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
show ?thesis
proof(rule arr_Rel_eqI[of Ξ±])
from GF'_GF show arr_Rel_GF'_GF:
"arr_Rel Ξ± (prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F)"
by (auto dest: cat_Rel_is_arrD(1))
from GG'_FF' show arr_Rel_GG'_FF':
"arr_Rel Ξ± (prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F))"
by (auto dest: cat_Rel_is_arrD(1))
show "(prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F)β¦ArrValβ¦ =
prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F)β¦ArrValβ¦"
proof(intro vsubset_antisym vsubsetI)
fix R assume
"R ββ©β (prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F)β¦ArrValβ¦"
from this assms have "R ββ©β
prod_2_Rel_ArrVal (G'β¦ArrValβ¦) (F'β¦ArrValβ¦) ββ©β
prod_2_Rel_ArrVal (Gβ¦ArrValβ¦) (Fβ¦ArrValβ¦)"
by
(
cs_prems
cs_simp:
prod_2_Rel_components(1)
comp_Rel_components(1)
cat_Rel_cs_simps
cs_intro: cat_Rel_par_set_cs_intros
)
from this[unfolded prod_2_Rel_ArrVal_vcomp] assms show
"R ββ©β prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F)β¦ArrValβ¦"
by
(
cs_concl cs_simp:
prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps
)
next
fix R assume
"R ββ©β prod_2_Rel (G' ββ©Aβcat_Rel Ξ±β G) (F' ββ©Aβcat_Rel Ξ±β F)β¦ArrValβ¦"
from this assms have
"R ββ©β prod_2_Rel_ArrVal (G'β¦ArrValβ¦ ββ©β Gβ¦ArrValβ¦) (F'β¦ArrValβ¦ ββ©β Fβ¦ArrValβ¦)"
by
(
cs_prems cs_simp:
comp_Rel_components prod_2_Rel_components cat_Rel_cs_simps
)
from this[folded prod_2_Rel_ArrVal_vcomp] assms show
"R ββ©β (prod_2_Rel G' F' ββ©Aβcat_Rel Ξ±β prod_2_Rel G F)β¦ArrValβ¦"
by
(
cs_concl
cs_simp:
prod_2_Rel_components comp_Rel_components(1) cat_Rel_cs_simps
cs_intro: cat_Rel_par_set_cs_intros
)
qed
qed
(
use GF'_GF assms in
βΉ
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Rel_cs_intros
βΊ
)+
qed
lemma (in π΅) prod_2_Rel_CId[cat_cs_simps]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦" and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
shows
"prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦) (cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦) = cat_Rel Ξ±β¦CIdβ¦β¦A Γβ©β Bβ¦"
proof-
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ by (rule category_cat_Rel)
from assms have A_B:
"prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦) (cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦) :
A Γβ©β B β¦βcat_Rel Ξ±β A Γβ©β B"
by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
from assms Rel.category_axioms have AB:
"cat_Rel Ξ±β¦CIdβ¦β¦A Γβ©β Bβ¦ : A Γβ©β B β¦βcat_Rel Ξ±β A Γβ©β B"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cs_intro: V_cs_intros cat_cs_intros
)
show ?thesis
proof(rule arr_Rel_eqI)
from A_B show arr_Rel_GF'_GF:
"arr_Rel Ξ± (prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦) (cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦))"
by (auto dest: cat_Rel_is_arrD(1))
from AB show arr_Rel_GG'_FF': "arr_Rel Ξ± (cat_Rel Ξ±β¦CIdβ¦β¦A Γβ©β Bβ¦)"
by (auto dest: cat_Rel_is_arrD(1))
from assms show
"prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦) (cat_Rel Ξ±β¦CIdβ¦β¦Bβ¦)β¦ArrValβ¦ =
cat_Rel Ξ±β¦CIdβ¦β¦A Γβ©β Bβ¦β¦ArrValβ¦"
by
(
cs_concl
cs_simp:
id_Rel_components prod_2_Rel_components
cat_cs_simps cat_Rel_cs_simps
cs_intro: V_cs_intros cat_cs_intros
)
qed
(
use A_B assms in
βΉ
cs_concl
cs_simp: prod_2_Rel_components cat_Rel_cs_simps
cs_intro: cat_cs_intros
βΊ
)+
qed
subsectionβΉProduct functor for βΉRelβΊβΊ
definition cf_prod_2_Rel :: "V β V"
where "cf_prod_2_Rel π =
[
(Ξ»ABββ©β(π Γβ©C π)β¦Objβ¦. ABβ¦0β¦ Γβ©β ABβ¦1β©ββ¦),
(Ξ»STββ©β(π Γβ©C π)β¦Arrβ¦. prod_2_Rel (STβ¦0β¦) (STβ¦1β©ββ¦)),
π Γβ©C π,
π
]β©β"
textβΉComponents.βΊ
lemma cf_prod_2_Rel_components:
shows "cf_prod_2_Rel πβ¦ObjMapβ¦ = (Ξ»ABββ©β(π Γβ©C π)β¦Objβ¦. ABβ¦0β¦ Γβ©β ABβ¦1β©ββ¦)"
and "cf_prod_2_Rel πβ¦ArrMapβ¦ =
(Ξ»STββ©β(π Γβ©C π)β¦Arrβ¦. prod_2_Rel (STβ¦0β¦) (STβ¦1β©ββ¦))"
and [cat_cs_simps]: "cf_prod_2_Rel πβ¦HomDomβ¦ = π Γβ©C π"
and [cat_cs_simps]: "cf_prod_2_Rel πβ¦HomCodβ¦ = π"
unfolding cf_prod_2_Rel_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda cf_prod_2_Rel_components(1)
|vsv cf_prod_2_Rel_ObjMap_vsv[cat_cs_intros]|
|vdomain cf_prod_2_Rel_ObjMap_vdomain[cat_cs_simps]|
lemma cf_prod_2_Rel_ObjMap_app[cat_cs_simps]:
assumes "AB = [A, B]β©β" and "AB ββ©β (π Γβ©C π)β¦Objβ¦"
shows "A ββ©Hβ©Mβ©.β©Oβcf_prod_2_Rel πβ B = A Γβ©β B"
using assms(2)
unfolding assms(1) cf_prod_2_Rel_components
by (simp add: nat_omega_simps)
lemma (in π΅) cf_prod_2_Rel_ObjMap_vrange:
"ββ©β (cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦) ββ©β cat_Rel Ξ±β¦Objβ¦"
proof-
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ
by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
show ?thesis
proof(rule vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
fix AB assume prems: "AB ββ©β (cat_Rel Ξ± Γβ©C cat_Rel Ξ±)β¦Objβ¦"
with Rel.category_axioms obtain A B where AB_def: "AB = [A, B]β©β"
and A: "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and B: "B ββ©β cat_Rel Ξ±β¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2])
from prems A B show "cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦β¦ABβ¦ ββ©β cat_Rel Ξ±β¦Objβ¦"
unfolding AB_def cat_Rel_components(1)
by (cs_concl cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: V_cs_intros)
qed (cs_concl cs_intro: cat_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_prod_2_Rel_components(2)
|vsv cf_prod_2_Rel_ArrMap_vsv[cat_cs_intros]|
|vdomain cf_prod_2_Rel_ArrMap_vdomain[cat_cs_simps]|
lemma cf_prod_2_Rel_ArrMap_app[cat_cs_simps]:
assumes "GF = [G, F]β©β" and "GF ββ©β (π Γβ©C π)β¦Arrβ¦"
shows "G ββ©Hβ©Mβ©.β©Aβcf_prod_2_Rel πβ F = prod_2_Rel G F"
using assms(2)
unfolding assms(1) cf_prod_2_Rel_components
by (simp add: nat_omega_simps)
subsubsectionβΉProduct functor for βΉRelβΊ is a functorβΊ
lemma (in π΅) cf_prod_2_Rel_is_functor:
"cf_prod_2_Rel (cat_Rel Ξ±) : cat_Rel Ξ± Γβ©C cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
proof-
interpret Rel: category Ξ± βΉcat_Rel Ξ±βΊ
by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
show ?thesis
proof(rule is_functorI')
show "vfsequence (cf_prod_2_Rel (cat_Rel Ξ±))"
unfolding cf_prod_2_Rel_def by auto
show "vcard (cf_prod_2_Rel (cat_Rel Ξ±)) = 4β©β"
unfolding cf_prod_2_Rel_def by (simp add: nat_omega_simps)
show "ββ©β (cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦) ββ©β cat_Rel Ξ±β¦Objβ¦"
by (rule cf_prod_2_Rel_ObjMap_vrange)
show "cf_prod_2_Rel (cat_Rel Ξ±)β¦ArrMapβ¦β¦GFβ¦ :
cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦β¦ABβ¦ β¦βcat_Rel Ξ±β
cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦β¦CDβ¦"
if "GF : AB β¦βcat_Rel Ξ± Γβ©C cat_Rel Ξ±β CD" for AB CD GF
proof-
from that obtain G F A B C D
where GF_def: "GF = [G, F]β©β"
and AB_def: "AB = [A, B]β©β"
and CD_def: "CD = [C, D]β©β"
and G: "G : A β¦βcat_Rel Ξ±β C"
and F: "F : B β¦βcat_Rel Ξ±β D"
by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
from that G F show ?thesis
unfolding GF_def AB_def CD_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro:
cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
)
qed
show
"cf_prod_2_Rel (cat_Rel Ξ±)β¦ArrMapβ¦β¦GF' ββ©Aβcat_Rel Ξ± Γβ©C cat_Rel Ξ±β GFβ¦ =
cf_prod_2_Rel (cat_Rel Ξ±)β¦ArrMapβ¦β¦GF'β¦ ββ©Aβcat_Rel Ξ±β
cf_prod_2_Rel (cat_Rel Ξ±)β¦ArrMapβ¦β¦GFβ¦"
if "GF' : AB' β¦βcat_Rel Ξ± Γβ©C cat_Rel Ξ±β AB''"
and "GF : AB β¦βcat_Rel Ξ± Γβ©C cat_Rel Ξ±β AB'"
for AB' AB'' GF' AB GF
proof-
from that(2) obtain G F A A' B B'
where GF_def: "GF = [G, F]β©β"
and AB_def: "AB = [A, B]β©β"
and AB'_def: "AB' = [A', B']β©β"
and G: "G : A β¦βcat_Rel Ξ±β A'"
and F: "F : B β¦βcat_Rel Ξ±β B'"
by (elim cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms])
with that(1) obtain G' F' A'' B''
where GF'_def: "GF' = [G', F']β©β"
and AB''_def: "AB'' = [A'', B'']β©β"
and G': "G' : A' β¦βcat_Rel Ξ±β A''"
and F': "F' : B' β¦βcat_Rel Ξ±β B''"
by
(
auto elim:
cat_prod_2_is_arrE[OF Rel.category_axioms Rel.category_axioms]
)
from that G F G' F' show ?thesis
unfolding GF_def AB_def AB'_def GF'_def AB''_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps prod_2_Rel_Comp
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
show
"cf_prod_2_Rel (cat_Rel Ξ±)β¦ArrMapβ¦β¦(cat_Rel Ξ± Γβ©C cat_Rel Ξ±)β¦CIdβ¦β¦ABβ¦β¦ =
cat_Rel Ξ±β¦CIdβ¦β¦cf_prod_2_Rel (cat_Rel Ξ±)β¦ObjMapβ¦β¦ABβ¦β¦"
if "AB ββ©β (cat_Rel Ξ± Γβ©C cat_Rel Ξ±)β¦Objβ¦" for AB
proof-
from that obtain A B
where AB_def: "AB = [A, B]β©β"
and A: "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and B: "B ββ©β cat_Rel Ξ±β¦Objβ¦"
by (elim cat_prod_2_ObjE[OF Rel.category_axioms Rel.category_axioms])
from A B show ?thesis
unfolding AB_def
by
(
cs_concl
cs_simp:
cf_prod_2_Rel_ObjMap_app cf_prod_2_Rel_ArrMap_app
cat_cs_simps cat_prod_cs_simps
cs_intro:
V_cs_intros cat_cs_intros cat_Rel_cs_intros cat_prod_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_cs_intros cat_Rel_cs_intros
)+
qed
lemma (in π΅) cf_prod_2_Rel_is_functor'[cat_cs_intros]:
assumes "π' = cat_Rel Ξ± Γβ©C cat_Rel Ξ±"
and "π
' = cat_Rel Ξ±"
and "Ξ±' = Ξ±"
shows "cf_prod_2_Rel (cat_Rel Ξ±) : π' β¦β¦β©CβΞ±'β π
'"
unfolding assms by (rule cf_prod_2_Rel_is_functor)
lemmas [cat_cs_intros] = π΅.cf_prod_2_Rel_is_functor'
subsectionβΉProduct universal property arrow for βΉSetβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_Set_obj_prod_up :: "V β (V β V) β V β (V β V) β V"
where "cat_Set_obj_prod_up I F A Ο =
[(Ξ»aββ©βA. (Ξ»iββ©βI. Ο iβ¦ArrValβ¦β¦aβ¦)), A, (ββ©βiββ©βI. F i)]β©β"
textβΉComponents.βΊ
lemma cat_Set_obj_prod_up_components:
shows "cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦ =
(Ξ»aββ©βA. (Ξ»iββ©βI. Ο iβ¦ArrValβ¦β¦aβ¦))"
and [cat_Set_cs_simps]:
"cat_Set_obj_prod_up I F A Οβ¦ArrDomβ¦ = A"
and [cat_Set_cs_simps]:
"cat_Set_obj_prod_up I F A Οβ¦ArrCodβ¦ = (ββ©βiββ©βI. F i)"
unfolding cat_Set_obj_prod_up_def arr_field_simps
by (simp_all add: nat_omega_simps)
textβΉArrow value.βΊ
mk_VLambda cat_Set_obj_prod_up_components(1)
|vsv cat_Set_obj_prod_up_ArrVal_vsv[cat_Set_cs_intros]|
|vdomain cat_Set_obj_prod_up_ArrVal_vdomain[cat_Set_cs_simps]|
|app cat_Set_obj_prod_up_ArrVal_app|
lemma cat_Set_obj_prod_up_ArrVal_vrange:
assumes "βi. i ββ©β I βΉ Ο i : A β¦βcat_Set Ξ±β F i"
shows "ββ©β (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦) ββ©β (ββ©βiββ©βI. F i)"
unfolding cat_Set_obj_prod_up_components
proof(intro vrange_VLambda_vsubset vproductI)
fix a assume prems: "a ββ©β A"
show "βiββ©βI. (Ξ»iββ©βI. Ο iβ¦ArrValβ¦β¦aβ¦)β¦iβ¦ ββ©β F i"
proof(intro ballI)
fix i assume "i ββ©β I"
with assms prems show "(Ξ»iββ©βI. Ο iβ¦ArrValβ¦β¦aβ¦)β¦iβ¦ ββ©β F i"
by (cs_concl cs_simp: V_cs_simps cs_intro: cat_Set_cs_intros)
qed
qed auto
lemma cat_Set_obj_prod_up_ArrVal_app_vdomain[cat_Set_cs_simps]:
assumes "a ββ©β A"
shows "πβ©β (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦) = I"
unfolding cat_Set_obj_prod_up_ArrVal_app[OF assms] by simp
lemma cat_Set_obj_prod_up_ArrVal_app_component[cat_Set_cs_simps]:
assumes "a ββ©β A" and "i ββ©β I"
shows "cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦β¦iβ¦ = Ο iβ¦ArrValβ¦β¦aβ¦"
using assms
by (cs_concl cs_simp: cat_Set_obj_prod_up_ArrVal_app V_cs_simps)
lemma cat_Set_obj_prod_up_ArrVal_app_vrange:
assumes "a ββ©β A" and "βi. i ββ©β I βΉ Ο i : A β¦βcat_Set Ξ±β F i"
shows "ββ©β (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦) ββ©β (ββ©βiββ©βI. F i)"
proof(intro vsubsetI)
fix b assume prems: "b ββ©β ββ©β (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦)"
from assms(1) have "vsv (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦)"
by (auto simp: cat_Set_obj_prod_up_components)
with prems obtain i
where b_def: "b = cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦β¦aβ¦β¦iβ¦"
and i: "i ββ©β I"
by
(
auto
elim: vsv.vrange_atE
simp: cat_Set_obj_prod_up_ArrVal_app[OF assms(1)]
)
from cat_Set_obj_prod_up_ArrVal_app_component[OF assms(1) i] b_def have b_def':
"b = Ο iβ¦ArrValβ¦β¦aβ¦"
by simp
from assms(1) assms(2)[OF i] have "b ββ©β F i"
unfolding b_def' by (cs_concl cs_intro: cat_Set_cs_intros)
with i show "b ββ©β (ββ©βiββ©βI. F i)" by force
qed
subsubsectionβΉProduct universal property arrow for βΉSetβΊ is an arrow in βΉSetβΊβΊ
lemma (in π΅) cat_Set_obj_prod_up_cat_Set_is_arr:
assumes "A ββ©β Vset Ξ±"
and "VLambda I F ββ©β Vset Ξ±"
and "βi. i ββ©β I βΉ Ο i : A β¦βcat_Set Ξ±β F i"
shows "cat_Set_obj_prod_up I F A Ο : A β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i)"
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (cat_Set_obj_prod_up I F A Ο)"
unfolding cat_Set_obj_prod_up_def by auto
show "vcard (cat_Set_obj_prod_up I F A Ο) = 3β©β"
unfolding cat_Set_obj_prod_up_def by (auto simp: nat_omega_simps)
show
"ββ©β (cat_Set_obj_prod_up I F A Οβ¦ArrValβ¦) ββ©β
cat_Set_obj_prod_up I F A Οβ¦ArrCodβ¦"
unfolding cat_Set_obj_prod_up_components(3)
by (rule cat_Set_obj_prod_up_ArrVal_vrange[OF assms(3)])
show "cat_Set_obj_prod_up I F A Οβ¦ArrCodβ¦ ββ©β Vset Ξ±"
unfolding cat_Set_cs_simps
by (rule Limit_vproduct_in_Vset_if_VLambda_in_VsetI)
(simp_all add: cat_Set_cs_simps assms)
qed (auto simp: assms cat_Set_cs_simps intro: cat_Set_cs_intros)
lemma (in π΅) pdg_dghm_comp_dghm_proj_dghm_up:
assumes "A ββ©β Vset Ξ±"
and "VLambda I F ββ©β Vset Ξ±"
and "βi. i ββ©β I βΉ Ο i : A β¦βcat_Set Ξ±β F i"
and "i ββ©β I"
shows
"Ο i = vprojection_arrow I F i ββ©Aβcat_Set Ξ±β cat_Set_obj_prod_up I F A Ο"
(is βΉΟ i = ?Fi ββ©Aβcat_Set Ξ±β ?ΟβΊ)
proof(rule arr_Set_eqI[of Ξ±])
note Οi = assms(3)[OF assms(4)]
note Οi = cat_Set_is_arrD[OF Οi] Οi
have Fi: "?Fi : (ββ©βiββ©βI. F i) β¦βcat_Set Ξ±β F i"
by (rule vprojection_arrow_is_arr[OF assms(4,2)])
from cat_Set_obj_prod_up_cat_Set_is_arr[OF assms(1,2,3)] have Ο:
"cat_Set_obj_prod_up I F A Ο : A β¦βcat_Set Ξ±β (ββ©βiββ©βI. F i)"
by simp
show "arr_Set Ξ± (Ο i)" by (rule Οi(1))
interpret Οi: arr_Set Ξ± βΉΟ iβΊ by (rule Οi(1))
from Fi Ο have Fi_Ο: "?Fi ββ©Aβcat_Set Ξ±β ?Ο : A β¦βcat_Set Ξ±β F i"
by (cs_concl cs_intro: cat_cs_intros)
then show arr_Set_Fi_Ο: "arr_Set Ξ± (?Fi ββ©Aβcat_Set Ξ±β ?Ο)"
by (auto simp: cat_Set_is_arrD(1))
interpret arr_Set Ξ± βΉ?Fi ββ©Aβcat_Set Ξ±β ?ΟβΊ by (rule arr_Set_Fi_Ο)
from Οi have dom_lhs: "πβ©β (Ο iβ¦ArrValβ¦) = A"
by (cs_concl cs_simp: cat_cs_simps)
from Fi_Ο have dom_rhs: "πβ©β ((?Fi ββ©Aβcat_Set Ξ±β ?Ο)β¦ArrValβ¦) = A"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Ο iβ¦ArrValβ¦ = (?Fi ββ©Aβcat_Set Ξ±β ?Ο)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ββ©β A"
from assms(4) prems Οi(4) Ο Fi show
"Ο iβ¦ArrValβ¦β¦aβ¦ = (?Fi ββ©Aβcat_Set Ξ±β ?Ο)β¦ArrValβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps
cs_intro: cat_Set_cs_intros cat_cs_intros
)
qed auto
from Fi Ο show "Ο iβ¦ArrDomβ¦ = (?Fi ββ©Aβcat_Set Ξ±β ?Ο)β¦ArrDomβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_Set_cs_simps Οi(2))
from Fi Ο show "Ο iβ¦ArrCodβ¦ = (?Fi ββ©Aβcat_Set Ξ±β ?Ο)β¦ArrCodβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_Set_cs_simps Οi(3))
qed
subsectionβΉEqualizer object for the category βΉSetβΊβΊ
textβΉ
The definition of the (non-categorical concept of an) equalizer can be
found in \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}βΊ
definition vequalizer :: "V β V β V β V"
where "vequalizer X f g = set {x. x ββ©β X β§ fβ¦ArrValβ¦β¦xβ¦ = gβ¦ArrValβ¦β¦xβ¦}"
lemma small_vequalizer[simp]:
"small {x. x ββ©β X β§ fβ¦ArrValβ¦β¦xβ¦ = gβ¦ArrValβ¦β¦xβ¦}"
by auto
textβΉRules.βΊ
lemma vequalizerI:
assumes "x ββ©β X" and "fβ¦ArrValβ¦β¦xβ¦ = gβ¦ArrValβ¦β¦xβ¦"
shows "x ββ©β vequalizer X f g"
using assms unfolding vequalizer_def by auto
lemma vequalizerD[dest]:
assumes "x ββ©β vequalizer X f g"
shows "x ββ©β X" and "fβ¦ArrValβ¦β¦xβ¦ = gβ¦ArrValβ¦β¦xβ¦"
using assms unfolding vequalizer_def by auto
lemma vequalizerE[elim]:
assumes "x ββ©β vequalizer X f g"
obtains "x ββ©β X" and "fβ¦ArrValβ¦β¦xβ¦ = gβ¦ArrValβ¦β¦xβ¦"
using assms unfolding vequalizer_def by auto
textβΉElementary results.βΊ
lemma vequalizer_vsubset_vdomain[cat_Set_cs_intros]: "vequalizer a g f ββ©β a"
by auto
lemma Limit_vequalizer_in_Vset[cat_Set_cs_intros]:
assumes "Limit Ξ±" and "a ββ©β Vset Ξ±"
shows "vequalizer a g f ββ©β Vset Ξ±"
using assms by auto
lemma vequalizer_flip: "vequalizer a f g = vequalizer a g f"
unfolding vequalizer_def by auto
lemma (in π΅) cat_Set_incl_Set_commute:
assumes "π€ : π β¦βcat_Set Ξ±β π" and "π£ : π β¦βcat_Set Ξ±β π"
shows
"π€ ββ©Aβcat_Set Ξ±β incl_Set (vequalizer π π£ π€) π =
π£ ββ©Aβcat_Set Ξ±β incl_Set (vequalizer π π£ π€) π"
(is βΉπ€ ββ©Aβcat_Set Ξ±β ?incl = π£ ββ©Aβcat_Set Ξ±β ?inclβΊ)
proof-
note π€ = cat_Set_is_arrD[OF assms(1)]
interpret π€: arr_Set Ξ± π€
rewrites "π€β¦ArrDomβ¦ = π" and "π€β¦ArrCodβ¦ = π"
by (rule π€(1)) (simp_all add: π€)
note π£ = cat_Set_is_arrD[OF assms(2)]
interpret π£: arr_Set Ξ± π£
rewrites "π£β¦ArrDomβ¦ = π" and "π£β¦ArrCodβ¦ = π"
by (rule π£(1)) (simp_all add: π£)
note [cat_Set_cs_intros] = π€.arr_Set_ArrDom_in_Vset π£.arr_Set_ArrCod_in_Vset
from assms have π€_incl:
"π€ ββ©Aβcat_Set Ξ±β ?incl : vequalizer π π£ π€ β¦βcat_Set Ξ±β π"
by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
then have dom_lhs: "πβ©β ((π€ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦) = vequalizer π π£ π€"
by (cs_concl cs_simp: cat_cs_simps)+
from assms have π£_incl:
"π£ ββ©Aβcat_Set Ξ±β ?incl : vequalizer π π£ π€ β¦βcat_Set Ξ±β π"
by (cs_concl cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros)
then have dom_rhs: "πβ©β ((π£ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦) = vequalizer π π£ π€"
by (cs_concl cs_simp: cat_cs_simps)+
show ?thesis
proof(rule arr_Set_eqI)
from π€_incl show arr_Set_π€_incl: "arr_Set Ξ± (π€ ββ©Aβcat_Set Ξ±β ?incl)"
by (auto dest: cat_Set_is_arrD(1))
interpret arr_Set_π€_incl: arr_Set Ξ± βΉπ€ ββ©Aβcat_Set Ξ±β ?inclβΊ
by (rule arr_Set_π€_incl)
from π£_incl show arr_Set_π£_incl: "arr_Set Ξ± (π£ ββ©Aβcat_Set Ξ±β ?incl)"
by (auto dest: cat_Set_is_arrD(1))
interpret arr_Set_π£_incl: arr_Set Ξ± βΉπ£ ββ©Aβcat_Set Ξ±β ?inclβΊ
by (rule arr_Set_π£_incl)
show "(π€ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦ = (π£ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β vequalizer π π£ π€"
with assms show
"(π€ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦β¦aβ¦ = (π£ ββ©Aβcat_Set Ξ±β ?incl)β¦ArrValβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: vequalizerD(2) cat_Set_cs_simps cat_cs_simps
cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
)
qed auto
qed (use π€_incl π£_incl in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
subsectionβΉAuxiliaryβΊ
textβΉ
This subsection is reserved for insignificant helper lemmas
and rules that are used in applied formalization elsewhere.
βΊ
lemma (in π΅) cat_Rel_CId_is_cat_Set_arr:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦ : A β¦βcat_Set Ξ±β A"
proof-
from assms show ?thesis
unfolding cat_Rel_components cat_Set_components(6)[symmetric]
by (cs_concl cs_simp: cat_Set_components(1) cs_intro: cat_cs_intros)
qed
lemma (in π΅) cat_Rel_CId_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B' = A"
and "C' = A"
and "β' = cat_Set Ξ±"
shows "cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦ : B' β¦ββ'β C'"
using assms(1) unfolding assms(2-4) by (rule cat_Rel_CId_is_cat_Set_arr)
textβΉ\newpageβΊ
end
Theory CZH_ECAT_GRPH
sectionβΉβΉGRPHβΊβΊ
theory CZH_ECAT_GRPH
imports
CZH_ECAT_Small_Category
CZH_Foundations.CZH_SMC_GRPH
begin
subsectionβΉBackgroundβΊ
textβΉ
The methodology for the exposition of βΉGRPHβΊ as a category is analogous to
the one used in the previous installment of this body of work
for the exposition of βΉGRPHβΊ as a semicategory.
βΊ
named_theorems cat_GRPH_simps
named_theorems cat_GRPH_intros
subsectionβΉDefinition and elementary propertiesβΊ
definition cat_GRPH :: "V β V"
where "cat_GRPH Ξ± =
[
set {β. digraph Ξ± β},
all_dghms Ξ±,
(Ξ»πββ©βall_dghms Ξ±. πβ¦HomDomβ¦),
(Ξ»πββ©βall_dghms Ξ±. πβ¦HomCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_GRPH Ξ±). ππβ¦0β¦ ββ©Dβ©Gβ©Hβ©M ππβ¦1β©ββ¦),
(Ξ»βββ©βset {β. digraph Ξ± β}. dghm_id β)
]β©β"
textβΉComponents.βΊ
lemma cat_GRPH_components:
shows "cat_GRPH Ξ±β¦Objβ¦ = set {β. digraph Ξ± β}"
and "cat_GRPH Ξ±β¦Arrβ¦ = all_dghms Ξ±"
and "cat_GRPH Ξ±β¦Domβ¦ = (Ξ»πββ©βall_dghms Ξ±. πβ¦HomDomβ¦)"
and "cat_GRPH Ξ±β¦Codβ¦ = (Ξ»πββ©βall_dghms Ξ±. πβ¦HomCodβ¦)"
and "cat_GRPH Ξ±β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_GRPH Ξ±). ππβ¦0β¦ ββ©Dβ©Gβ©Hβ©M ππβ¦1β©ββ¦)"
and "cat_GRPH Ξ±β¦CIdβ¦ = (Ξ»βββ©βset {β. digraph Ξ± β}. dghm_id β)"
unfolding cat_GRPH_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_GRPH: "cat_smc (cat_GRPH Ξ±) = smc_GRPH Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cat_smc (cat_GRPH Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_GRPH Ξ±) = 5β©β"
unfolding smc_GRPH_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_GRPH Ξ±)) = πβ©β (smc_GRPH Ξ±)"
unfolding dom_lhs dom_rhs by simp
show
"a ββ©β πβ©β (cat_smc (cat_GRPH Ξ±)) βΉ cat_smc (cat_GRPH Ξ±)β¦aβ¦ = smc_GRPH Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_GRPH_def smc_GRPH_def
)
(auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_GRPH_def)
lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps]:
cat_GRPH_ObjI = smc_GRPH_ObjI
and cat_GRPH_ObjD = smc_GRPH_ObjD
and cat_GRPH_ObjE = smc_GRPH_ObjE
and cat_GRPH_Obj_iff[cat_GRPH_simps] = smc_GRPH_Obj_iff
and cat_GRPH_Dom_app[cat_GRPH_simps] = smc_GRPH_Dom_app
and cat_GRPH_Cod_app[cat_GRPH_simps] = smc_GRPH_Cod_app
and cat_GRPH_is_arrI = smc_GRPH_is_arrI
and cat_GRPH_is_arrD = smc_GRPH_is_arrD
and cat_GRPH_is_arrE = smc_GRPH_is_arrE
and cat_GRPH_is_arr_iff[cat_GRPH_simps] = smc_GRPH_is_arr_iff
lemmas_with [folded cat_smc_GRPH, unfolded slicing_simps, unfolded cat_smc_GRPH]:
cat_GRPH_Comp_vdomain = smc_GRPH_Comp_vdomain
and cat_GRPH_composable_arrs_dg_GRPH = smc_GRPH_composable_arrs_dg_GRPH
and cat_GRPH_Comp = smc_GRPH_Comp
and cat_GRPH_Comp_app[cat_GRPH_simps] = smc_GRPH_Comp_app
lemmas_with (in π΅) [folded cat_smc_GRPH, unfolded slicing_simps]:
cat_GRPH_obj_initialI = smc_GRPH_obj_initialI
and cat_GRPH_obj_initialD = smc_GRPH_obj_initialD
and cat_GRPH_obj_initialE = smc_GRPH_obj_initialE
and cat_GRPH_obj_initial_iff[cat_GRPH_simps] = smc_GRPH_obj_initial_iff
and cat_GRPH_obj_terminalI = smc_GRPH_obj_terminalI
and cat_GRPH_obj_terminalE = smc_GRPH_obj_terminalE
subsectionβΉIdentityβΊ
lemma cat_GRPH_CId_app[cat_GRPH_simps]:
assumes "digraph Ξ± β"
shows "cat_GRPH Ξ±β¦CIdβ¦β¦ββ¦ = dghm_id β"
using assms unfolding cat_GRPH_components by simp
lemma cat_GRPH_CId_vdomain: "πβ©β (cat_GRPH Ξ±β¦CIdβ¦) = set {β. digraph Ξ± β}"
unfolding cat_GRPH_components by auto
lemma cat_GRPH_CId_vrange: "ββ©β (cat_GRPH Ξ±β¦CIdβ¦) ββ©β all_dghms Ξ±"
proof(rule vsubsetI)
fix β assume "β ββ©β ββ©β (cat_GRPH Ξ±β¦CIdβ¦)"
then obtain π
where β_def: "β = cat_GRPH Ξ±β¦CIdβ¦β¦πβ¦" and π: "π ββ©β πβ©β (cat_GRPH Ξ±β¦CIdβ¦)"
unfolding cat_GRPH_components by auto
from π have β_def': "β = dghm_id π"
unfolding β_def cat_GRPH_CId_vdomain by (auto simp: cat_GRPH_CId_app)
from π digraph.dg_dghm_id_is_dghm show "β ββ©β all_dghms Ξ±"
unfolding β_def' cat_GRPH_CId_vdomain by force
qed
subsectionβΉβΉGRPHβΊ is a categoryβΊ
lemma (in π΅) tiny_category_cat_GRPH:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² (cat_GRPH Ξ±)"
proof(intro tiny_categoryI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "vfsequence (cat_GRPH Ξ±)" unfolding cat_GRPH_def by simp
show "vcard (cat_GRPH Ξ±) = 6β©β"
unfolding cat_GRPH_def by (simp add: nat_omega_simps)
show "cat_GRPH Ξ±β¦CIdβ¦β¦π
β¦ ββ©Aβcat_GRPH Ξ±β π = π"
if "π : π β¦βcat_GRPH Ξ±β π
" for π π π
using that
unfolding cat_GRPH_is_arr_iff
by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
show "π ββ©Aβcat_GRPH Ξ±β cat_GRPH Ξ±β¦CIdβ¦β¦π
β¦ = π"
if "π : π
β¦βcat_GRPH Ξ±β β" for π π
β
using that
unfolding cat_GRPH_is_arr_iff
by (cs_concl cs_simp: dg_cs_simps cat_GRPH_simps cs_intro: dg_cs_intros)
qed
(
simp_all add:
assms
cat_smc_GRPH
cat_GRPH_components
digraph.dg_dghm_id_is_dghm
cat_GRPH_is_arr_iff
tiny_semicategory_smc_GRPH
)
subsectionβΉIsomorphismβΊ
lemma (in π΅) cat_GRPH_is_arr_isomorphismI:
assumes "π : π β¦β¦β©Dβ©Gβ©.β©iβ©sβ©oβΞ±β π
"
shows "π : π β¦β©iβ©sβ©oβcat_GRPH Ξ±β π
"
proof(intro is_arr_isomorphismI is_inverseI)
from assms show π: "π : π β¦βcat_GRPH Ξ±β π
"
unfolding cat_GRPH_is_arr_iff by auto
note iso_thms = is_iso_dghm_is_arr_isomorphism[OF assms]
from iso_thms(1) show inv_π: "inv_dghm π : π
β¦βcat_GRPH Ξ±β π"
unfolding cat_GRPH_is_arr_iff by auto
from assms show "π : π β¦βcat_GRPH Ξ±β π
"
unfolding cat_GRPH_is_arr_iff by auto
from assms have π: "digraph Ξ± π" and π
: "digraph Ξ± π
" by auto
show "inv_dghm π ββ©Aβcat_GRPH Ξ±β π = cat_GRPH Ξ±β¦CIdβ¦β¦πβ¦"
unfolding cat_GRPH_CId_app[OF π] cat_GRPH_Comp_app[OF inv_π π]
by (rule iso_thms(2))
show "π ββ©Aβcat_GRPH Ξ±β inv_dghm π = cat_GRPH Ξ±β¦CIdβ¦β¦π
β¦"
unfolding cat_GRPH_CId_app[OF π
] cat_GRPH_Comp_app[OF π inv_π]
by (rule iso_thms(3))
qed
lemma (in π΅) cat_GRPH_is_arr_isomorphismD:
assumes "π : π β¦β©iβ©sβ©oβcat_GRPH Ξ±β π
"
shows "π : π β¦β¦β©Dβ©Gβ©.β©iβ©sβ©oβΞ±β π
"
proof-
from is_arr_isomorphismD[OF assms] have π: "π : π β¦βcat_GRPH Ξ±β π
"
and "(βπ. is_inverse (cat_GRPH Ξ±) π π)"
by simp_all
then obtain π where ππ: "is_inverse (cat_GRPH Ξ±) π π" by clarsimp
then obtain π' π
' where π': "π : π
' β¦βcat_GRPH Ξ±β π'"
and π': "π : π' β¦βcat_GRPH Ξ±β π
'"
and ππ: "π ββ©Aβcat_GRPH Ξ±β π = cat_GRPH Ξ±β¦CIdβ¦β¦π'β¦"
and ππ: "π ββ©Aβcat_GRPH Ξ±β π = cat_GRPH Ξ±β¦CIdβ¦β¦π
'β¦"
by auto
from π π' have π': "π' = π" and π
': "π
' = π
" by auto
from π have π: "π : π β¦β¦β©Dβ©GβΞ±β π
" unfolding cat_GRPH_is_arr_iff by simp
then have π: "digraph Ξ± π" and π
: "digraph Ξ± π
" by auto
from π' have "π : π
β¦β¦β©Dβ©GβΞ±β π"
unfolding π' π
' cat_GRPH_is_arr_iff by simp
moreover from ππ have "π ββ©Dβ©Gβ©Hβ©M π = dghm_id π"
unfolding π' cat_GRPH_Comp_app[OF π' π'] cat_GRPH_CId_app[OF π] by simp
moreover from ππ have "π ββ©Dβ©Gβ©Hβ©M π = dghm_id π
"
unfolding π
' cat_GRPH_Comp_app[OF π' π'] cat_GRPH_CId_app[OF π
] by simp
ultimately show ?thesis using π by (elim is_arr_isomorphism_is_iso_dghm)
qed
lemma (in π΅) cat_GRPH_is_arr_isomorphismE:
assumes "π : π β¦β©iβ©sβ©oβcat_GRPH Ξ±β π
"
obtains "π : π β¦β¦β©Dβ©Gβ©.β©iβ©sβ©oβΞ±β π
"
using assms by (auto dest: cat_GRPH_is_arr_isomorphismD)
lemma (in π΅) cat_GRPH_is_arr_isomorphism_iff[cat_GRPH_simps]:
"π : π β¦β©iβ©sβ©oβcat_GRPH Ξ±β π
β· π : π β¦β¦β©Dβ©Gβ©.β©iβ©sβ©oβΞ±β π
"
using cat_GRPH_is_arr_isomorphismI cat_GRPH_is_arr_isomorphismD by auto
subsectionβΉIsomorphic objectsβΊ
lemma (in π΅) cat_GRPH_obj_isoI:
assumes "π ββ©Dβ©GβΞ±β π
"
shows "π ββ©oβ©bβ©jβcat_GRPH Ξ±β π
"
proof-
from iso_digraphD[OF assms] obtain π where "π : π β¦β¦β©Dβ©Gβ©.β©iβ©sβ©oβΞ±β π
"
by clarsimp
from cat_GRPH_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed
lemma (in π΅) cat_GRPH_obj_isoD:
assumes "π ββ©oβ©bβ©jβcat_GRPH Ξ±β π
"
shows "π ββ©Dβ©GβΞ±β π
"
proof-
from obj_isoD[OF assms] obtain π where "π : π β¦β©iβ©sβ©oβcat_GRPH Ξ±β π
"
by clarsimp
from cat_GRPH_is_arr_isomorphismD[OF this] show ?thesis
by (rule iso_digraphI)
qed
lemma (in π΅) cat_GRPH_obj_isoE:
assumes "π ββ©oβ©bβ©jβcat_GRPH Ξ±β π
"
obtains "π ββ©Dβ©GβΞ±β π
"
using assms by (auto simp: cat_GRPH_obj_isoD)
lemma (in π΅) cat_GRPH_obj_iso_iff: "π ββ©oβ©bβ©jβcat_GRPH Ξ±β π
β· π ββ©Dβ©GβΞ±β π
"
using cat_GRPH_obj_isoI cat_GRPH_obj_isoD by (intro iffI) auto
textβΉ\newpageβΊ
end
Theory CZH_ECAT_SemiCAT
sectionβΉβΉSemiCATβΊβΊ
theory CZH_ECAT_SemiCAT
imports
CZH_Foundations.CZH_SMC_SemiCAT
CZH_ECAT_Small_Category
CZH_ECAT_Simple
begin
subsectionβΉBackgroundβΊ
textβΉ
The methodology for the exposition of βΉSemiCATβΊ as a category
is analogous to the one used in the previous installment
of this body of work for the exposition of βΉSemiCATβΊ
as a semicategory.
βΊ
named_theorems cat_SemiCAT_simps
named_theorems cat_SemiCAT_intros
subsectionβΉDefinition and elementary propertiesβΊ
definition cat_SemiCAT :: "V β V"
where "cat_SemiCAT Ξ± =
[
set {β. semicategory Ξ± β},
all_smcfs Ξ±,
(Ξ»πββ©βall_smcfs Ξ±. πβ¦HomDomβ¦),
(Ξ»πββ©βall_smcfs Ξ±. πβ¦HomCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_SemiCAT Ξ±). ππβ¦0β¦ ββ©Sβ©Mβ©Cβ©F ππβ¦1β©ββ¦),
(Ξ»βββ©βset {β. semicategory Ξ± β}. smcf_id β)
]β©β"
textβΉComponents.βΊ
lemma cat_SemiCAT_components:
shows "cat_SemiCAT Ξ±β¦Objβ¦ = set {β. semicategory Ξ± β}"
and "cat_SemiCAT Ξ±β¦Arrβ¦ = all_smcfs Ξ±"
and "cat_SemiCAT Ξ±β¦Domβ¦ = (Ξ»πββ©βall_smcfs Ξ±. πβ¦HomDomβ¦)"
and "cat_SemiCAT Ξ±β¦Codβ¦ = (Ξ»πββ©βall_smcfs Ξ±. πβ¦HomCodβ¦)"
and "cat_SemiCAT Ξ±β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_SemiCAT Ξ±). ππβ¦0β¦ ββ©Sβ©Mβ©Cβ©F ππβ¦1β©ββ¦)"
and "cat_SemiCAT Ξ±β¦CIdβ¦ = (Ξ»βββ©βset {β. semicategory Ξ± β}. smcf_id β)"
unfolding cat_SemiCAT_def dg_field_simps
by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_SemiCAT: "cat_smc (cat_SemiCAT Ξ±) = smc_SemiCAT Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cat_smc (cat_SemiCAT Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_SemiCAT Ξ±) = 5β©β"
unfolding smc_SemiCAT_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_SemiCAT Ξ±)) = πβ©β (smc_SemiCAT Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_SemiCAT Ξ±)) βΉ
cat_smc (cat_SemiCAT Ξ±)β¦aβ¦ = smc_SemiCAT Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_SemiCAT_def smc_SemiCAT_def
)
(auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_SemiCAT_def)
lemmas_with [folded cat_smc_SemiCAT, unfolded slicing_simps]:
cat_SemiCAT_ObjI = smc_SemiCAT_ObjI
and cat_SemiCAT_ObjD = smc_SemiCAT_ObjD
and cat_SemiCAT_ObjE = smc_SemiCAT_ObjE
and cat_SemiCAT_Obj_iff[cat_SemiCAT_simps] = smc_SemiCAT_Obj_iff
and cat_SemiCAT_Dom_app[cat_SemiCAT_simps] = smc_SemiCAT_Dom_app
and cat_SemiCAT_Cod_app[cat_SemiCAT_simps] = smc_SemiCAT_Cod_app
and cat_SemiCAT_is_arrI = smc_SemiCAT_is_arrI
and cat_SemiCAT_is_arrD = smc_SemiCAT_is_arrD
and cat_SemiCAT_is_arrE = smc_SemiCAT_is_arrE
and cat_SemiCAT_is_arr_iff[cat_SemiCAT_simps] = smc_SemiCAT_is_arr_iff
lemmas_with [
folded cat_smc_SemiCAT, unfolded slicing_simps, unfolded cat_smc_SemiCAT
]:
cat_SemiCAT_Comp_vdomain = smc_SemiCAT_Comp_vdomain
and cat_SemiCAT_composable_arrs_dg_SemiCAT =
smc_SemiCAT_composable_arrs_dg_SemiCAT
and cat_SemiCAT_Comp = smc_SemiCAT_Comp
and cat_SemiCAT_Comp_app[cat_SemiCAT_simps] = smc_SemiCAT_Comp_app
and cat_SemiCAT_Comp_vrange = smc_SemiCAT_Comp_vrange
lemmas_with (in π΅) [folded cat_smc_SemiCAT, unfolded slicing_simps]:
cat_SemiCAT_obj_initialI = smc_SemiCAT_obj_initialI
and cat_SemiCAT_obj_initialD = smc_SemiCAT_obj_initialD
and cat_SemiCAT_obj_initialE = smc_SemiCAT_obj_initialE
and cat_SemiCAT_obj_initial_iff[cat_SemiCAT_simps] =
smc_SemiCAT_obj_initial_iff
and cat_SemiCAT_obj_terminalI = smc_SemiCAT_obj_terminalI
and cat_SemiCAT_obj_terminalE = smc_SemiCAT_obj_terminalE
subsectionβΉIdentityβΊ
lemma cat_SemiCAT_CId_app[cat_SemiCAT_simps]:
assumes "semicategory Ξ± β"
shows "cat_SemiCAT Ξ±β¦CIdβ¦β¦ββ¦ = smcf_id β"
using assms unfolding cat_SemiCAT_components by simp
lemma cat_SemiCAT_CId_vdomain[cat_SemiCAT_simps]:
"πβ©β (cat_SemiCAT Ξ±β¦CIdβ¦) = set {β. semicategory Ξ± β}"
unfolding cat_SemiCAT_components by auto
lemma cat_SemiCAT_CId_vrange: "ββ©β (cat_SemiCAT Ξ±β¦CIdβ¦) ββ©β all_smcfs Ξ±"
proof(rule vsubsetI)
fix β assume "β ββ©β ββ©β (cat_SemiCAT Ξ±β¦CIdβ¦)"
then obtain π
where β_def: "β = cat_SemiCAT Ξ±β¦CIdβ¦β¦πβ¦"
and π: "π ββ©β πβ©β (cat_SemiCAT Ξ±β¦CIdβ¦)"
unfolding cat_SemiCAT_components by auto
from π have β_def': "β = smcf_id π"
unfolding β_def cat_SemiCAT_CId_vdomain by (auto simp: cat_SemiCAT_CId_app)
from π semicategory.smc_smcf_id_is_semifunctor show "β ββ©β all_smcfs Ξ±"
unfolding β_def' cat_SemiCAT_CId_vdomain by force
qed
subsectionβΉβΉSemiCATβΊ is a categoryβΊ
lemma (in π΅) tiny_category_cat_SemiCAT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² (cat_SemiCAT Ξ±)"
proof(intro tiny_categoryI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "vfsequence (cat_SemiCAT Ξ±)" unfolding cat_SemiCAT_def by simp
show "vcard (cat_SemiCAT Ξ±) = 6β©β"
unfolding cat_SemiCAT_def by (simp add: nat_omega_simps)
show "cat_SemiCAT Ξ±β¦CIdβ¦β¦π
β¦ ββ©Aβcat_SemiCAT Ξ±β π = π"
if "π : π β¦βcat_SemiCAT Ξ±β π
" for π π π
using that
unfolding cat_SemiCAT_is_arr_iff
by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
show "π ββ©Aβcat_SemiCAT Ξ±β cat_SemiCAT Ξ±β¦CIdβ¦β¦π
β¦ = π"
if "π : π
β¦βcat_SemiCAT Ξ±β β" for π π
β
using that
unfolding cat_SemiCAT_is_arr_iff
by (cs_concl cs_simp: smc_cs_simps cat_SemiCAT_simps cs_intro: smc_cs_intros)
qed
(
simp_all add:
assms
cat_smc_SemiCAT
cat_SemiCAT_components
cat_SemiCAT_is_arr_iff
tiny_semicategory_smc_SemiCAT
semicategory.smc_smcf_id_is_semifunctor
)
subsectionβΉIsomorphismβΊ
lemma cat_SemiCAT_is_arr_isomorphismI:
assumes "π : π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows "π : π β¦β©iβ©sβ©oβcat_SemiCAT Ξ±β π
"
proof(intro is_arr_isomorphismI is_inverseI)
interpret is_iso_semifunctor Ξ± π π
π by (rule assms)
from assms show π: "π : π β¦βcat_SemiCAT Ξ±β π
"
unfolding cat_SemiCAT_is_arr_iff by auto
note iso_thms = is_iso_semifunctor_is_arr_isomorphism[OF assms]
from iso_thms(1) show inv_π: "inv_smcf π : π
β¦βcat_SemiCAT Ξ±β π"
unfolding cat_SemiCAT_is_arr_iff by auto
from assms show "π : π β¦βcat_SemiCAT Ξ±β π
"
unfolding cat_SemiCAT_is_arr_iff by auto
from assms have π: "semicategory Ξ± π" and π
: "semicategory Ξ± π
" by auto
show "inv_smcf π ββ©Aβcat_SemiCAT Ξ±β π = cat_SemiCAT Ξ±β¦CIdβ¦β¦πβ¦"
unfolding cat_SemiCAT_CId_app[OF π] cat_SemiCAT_Comp_app[OF inv_π π]
by (rule iso_thms(2))
show "π ββ©Aβcat_SemiCAT Ξ±β inv_smcf π = cat_SemiCAT Ξ±β¦CIdβ¦β¦π
β¦"
unfolding cat_SemiCAT_CId_app[OF π
] cat_SemiCAT_Comp_app[OF π inv_π]
by (rule iso_thms(3))
qed
lemma cat_SemiCAT_is_arr_isomorphismD:
assumes "π : π β¦β©iβ©sβ©oβcat_SemiCAT Ξ±β π
"
shows "π : π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
"
proof-
from is_arr_isomorphismD[OF assms] have π: "π : π β¦βcat_SemiCAT Ξ±β π
"
and "(βπ. is_inverse (cat_SemiCAT Ξ±) π π)"
by simp_all
then obtain π where ππ: "is_inverse (cat_SemiCAT Ξ±) π π" by clarsimp
then obtain π' π
' where π': "π : π
' β¦βcat_SemiCAT Ξ±β π'"
and π': "π : π' β¦βcat_SemiCAT Ξ±β π
'"
and ππ: "π ββ©Aβcat_SemiCAT Ξ±β π = cat_SemiCAT Ξ±β¦CIdβ¦β¦π'β¦"
and ππ: "π ββ©Aβcat_SemiCAT Ξ±β π = cat_SemiCAT Ξ±β¦CIdβ¦β¦π
'β¦"
by auto
from π π' have π': "π' = π" and π
': "π
' = π
" by auto
from π have π: "π : π β¦β¦β©Sβ©Mβ©CβΞ±β π
" unfolding cat_SemiCAT_is_arr_iff by simp
interpret is_semifunctor Ξ± π π
π by (rule π)
have π: "semicategory Ξ± π" and π
: "semicategory Ξ± π
"
by (cs_concl cs_intro: smc_cs_intros)+
from π' have π: "π : π
β¦β¦β©Sβ©Mβ©CβΞ±β π"
unfolding π' π
' cat_SemiCAT_is_arr_iff by simp
moreover from ππ have "π ββ©Sβ©Mβ©Cβ©F π = smcf_id π"
unfolding π' cat_SemiCAT_Comp_app[OF π' π'] cat_SemiCAT_CId_app[OF π]
by simp
moreover from ππ have "π ββ©Sβ©Mβ©Cβ©F π = smcf_id π
"
unfolding π
' cat_SemiCAT_Comp_app[OF π' π'] cat_SemiCAT_CId_app[OF π
]
by simp
ultimately show ?thesis
using π by (elim is_arr_isomorphism_is_iso_semifunctor)
qed
lemma cat_SemiCAT_is_arr_isomorphismE:
assumes "π : π β¦β©iβ©sβ©oβcat_SemiCAT Ξ±β π
"
obtains "π : π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
"
using assms by (auto dest: cat_SemiCAT_is_arr_isomorphismD)
lemma cat_SemiCAT_is_arr_isomorphism_iff[cat_SemiCAT_simps]:
"π : π β¦β©iβ©sβ©oβcat_SemiCAT Ξ±β π
β· π : π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
"
using cat_SemiCAT_is_arr_isomorphismI cat_SemiCAT_is_arr_isomorphismD by auto
subsectionβΉIsomorphic objectsβΊ
lemma cat_SemiCAT_obj_isoI:
assumes "π ββ©Sβ©Mβ©CβΞ±β π
"
shows "π ββ©oβ©bβ©jβcat_SemiCAT Ξ±β π
"
proof-
from iso_semicategoryD[OF assms] obtain π where "π : π β¦β¦β©Sβ©Mβ©Cβ©.β©iβ©sβ©oβΞ±β π
"
by clarsimp
from cat_SemiCAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed
lemma cat_SemiCAT_obj_isoD:
assumes "π ββ©oβ©bβ©jβcat_SemiCAT Ξ±β π
"
shows "π ββ©Sβ©Mβ©CβΞ±β π
"
proof-
from obj_isoD[OF assms] obtain π where "π : π β¦β©iβ©sβ©oβcat_SemiCAT Ξ±β π
"
by clarsimp
from cat_SemiCAT_is_arr_isomorphismD[OF this] show ?thesis
by (rule iso_semicategoryI)
qed
lemma cat_SemiCAT_obj_isoE:
assumes "π ββ©oβ©bβ©jβcat_SemiCAT Ξ±β π
"
obtains "π ββ©Sβ©Mβ©CβΞ±β π
"
using assms by (auto simp: cat_SemiCAT_obj_isoD)
lemma cat_SemiCAT_obj_iso_iff[cat_SemiCAT_simps]:
"π ββ©oβ©bβ©jβcat_SemiCAT Ξ±β π
β· π ββ©Sβ©Mβ©CβΞ±β π
"
using cat_SemiCAT_obj_isoI cat_SemiCAT_obj_isoD by (intro iffI) auto
textβΉ\newpageβΊ
end
Theory CZH_DG_CAT
sectionβΉβΉCATβΊ as a digraph\label{sec:dg_CAT}βΊ
theory CZH_DG_CAT
imports
CZH_ECAT_Functor
CZH_ECAT_Small_Category
begin
subsectionβΉBackgroundβΊ
textβΉ
βΉCATβΊ is usually defined as a category of categories and functors
(e.g., see Chapter I-2 in \cite{mac_lane_categories_2010}).
However, there is little that can prevent one from exposing βΉCATβΊ
as a digraph and provide additional structure gradually in
subsequent theories.
Thus, in this section, βΉΞ±βΊ-βΉCATβΊ is defined as a digraph of categories
and functors in the set βΉVβ©Ξ±βΊ, and βΉΞ±βΊ-βΉCatβΊ is defined
as a digraph of tiny categories and tiny functors in βΉVβ©Ξ±βΊ.
βΊ
named_theorems dg_CAT_simps
named_theorems dg_CAT_intros
subsectionβΉDefinition and elementary propertiesβΊ
definition dg_CAT :: "V β V"
where "dg_CAT Ξ± =
[
set {β. category Ξ± β},
all_cfs Ξ±,
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦),
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma dg_CAT_components:
shows "dg_CAT Ξ±β¦Objβ¦ = set {β. category Ξ± β}"
and "dg_CAT Ξ±β¦Arrβ¦ = all_cfs Ξ±"
and "dg_CAT Ξ±β¦Domβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦)"
and "dg_CAT Ξ±β¦Codβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦)"
unfolding dg_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)
subsectionβΉObjectβΊ
lemma dg_CAT_ObjI:
assumes "category Ξ± π"
shows "π ββ©β dg_CAT Ξ±β¦Objβ¦"
using assms unfolding dg_CAT_components by auto
lemma dg_CAT_ObjD:
assumes "π ββ©β dg_CAT Ξ±β¦Objβ¦"
shows "category Ξ± π"
using assms unfolding dg_CAT_components by auto
lemma dg_CAT_ObjE:
assumes "π ββ©β dg_CAT Ξ±β¦Objβ¦"
obtains "category Ξ± π"
using assms unfolding dg_CAT_components by auto
lemma dg_CAT_Obj_iff[dg_CAT_simps]: "π ββ©β dg_CAT Ξ±β¦Objβ¦ β· category Ξ± π"
unfolding dg_CAT_components by auto
subsectionβΉDomain and codomainβΊ
lemma [dg_CAT_simps]:
assumes "π ββ©β all_cfs Ξ±"
shows dg_CAT_Dom_app: "dg_CAT Ξ±β¦Domβ¦β¦πβ¦ = πβ¦HomDomβ¦"
and dg_CAT_Cod_app: "dg_CAT Ξ±β¦Codβ¦β¦πβ¦ = πβ¦HomCodβ¦"
using assms unfolding dg_CAT_components by auto
subsectionβΉβΉCATβΊ is a digraphβΊ
lemma (in π΅) tiny_category_dg_CAT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_digraph Ξ² (dg_CAT Ξ±)"
proof(intro tiny_digraphI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "vfsequence (dg_CAT Ξ±)" unfolding dg_CAT_def by simp
show "vcard (dg_CAT Ξ±) = 4β©β"
unfolding dg_CAT_def by (simp add: nat_omega_simps)
show "ββ©β (dg_CAT Ξ±β¦Domβ¦) ββ©β dg_CAT Ξ±β¦Objβ¦"
proof(intro vsubsetI)
fix π assume "π ββ©β ββ©β (dg_CAT Ξ±β¦Domβ¦)"
then obtain π where "π ββ©β all_cfs Ξ±" and "π = πβ¦HomDomβ¦"
unfolding dg_CAT_components by auto
then obtain π
π where "π : π β¦β¦β©CβΞ±β π
"
unfolding dg_CAT_components by auto
then interpret is_functor Ξ± π π
π by simp
show "π ββ©β dg_CAT Ξ±β¦Objβ¦"
by (simp add: dg_CAT_components HomDom.category_axioms)
qed
show "ββ©β (dg_CAT Ξ±β¦Codβ¦) ββ©β dg_CAT Ξ±β¦Objβ¦"
proof(intro vsubsetI)
fix π
assume "π
ββ©β ββ©β (dg_CAT Ξ±β¦Codβ¦)"
then obtain π where "π ββ©β πβ©β (dg_CAT Ξ±β¦Codβ¦)" and "π
= πβ¦HomCodβ¦"
unfolding dg_CAT_components by auto
then obtain π π
where dghm: "π : π β¦β¦β©CβΞ±β π
" and π
_def: "π
= πβ¦HomCodβ¦"
unfolding dg_CAT_components by auto
have "π
= πβ¦HomCodβ¦" unfolding π
_def by simp
interpret is_functor Ξ± π π
π by (rule dghm)
show "π
ββ©β dg_CAT Ξ±β¦Objβ¦"
by (simp add: HomCod.category_axioms dg_CAT_components)
qed
show "dg_CAT Ξ±β¦Objβ¦ ββ©β Vset Ξ²"
unfolding dg_CAT_components by (rule categories_in_Vset[OF assms])
show "dg_CAT Ξ±β¦Arrβ¦ ββ©β Vset Ξ²"
unfolding dg_CAT_components by (rule all_cfs_in_Vset[OF assms])
qed (simp_all add: assms dg_CAT_components)
subsectionβΉArrow with a domain and a codomainβΊ
lemma dg_CAT_is_arrI:
assumes "π : π β¦β¦β©CβΞ±β π
"
shows "π : π β¦βdg_CAT Ξ±β π
"
proof(intro is_arrI, unfold dg_CAT_components(2))
interpret is_functor Ξ± π π
π by (rule assms)
from assms show "π ββ©β all_cfs Ξ±" by auto
with assms show "dg_CAT Ξ±β¦Domβ¦β¦πβ¦ = π" "dg_CAT Ξ±β¦Codβ¦β¦πβ¦ = π
"
by (simp_all add: dg_CAT_components cat_cs_simps)
qed
lemma dg_CAT_is_arrD:
assumes "π : π β¦βdg_CAT Ξ±β π
"
shows "π : π β¦β¦β©CβΞ±β π
"
using assms by (elim is_arrE) (auto simp: dg_CAT_components)
lemma dg_CAT_is_arrE:
assumes "π : π β¦βdg_CAT Ξ±β π
"
obtains "π : π β¦β¦β©CβΞ±β π
"
using assms by (simp add: dg_CAT_is_arrD)
lemma dg_CAT_is_arr_iff[dg_CAT_simps]:
"π : π β¦βdg_CAT Ξ±β π
β· π : π β¦β¦β©CβΞ±β π
"
by (auto intro: dg_CAT_is_arrI dest: dg_CAT_is_arrD)
textβΉ\newpageβΊ
end
Theory CZH_SMC_CAT
sectionβΉβΉCATβΊ as a semicategory\label{sec:smc_CAT}βΊ
theory CZH_SMC_CAT
imports
CZH_DG_CAT
CZH_ECAT_Simple
begin
subsectionβΉBackgroundβΊ
textβΉ
The subsection presents the theory of the semicategories of βΉΞ±βΊ-categories.
It continues the development that was initiated in section
\ref{sec:dg_CAT}.
βΊ
named_theorems smc_CAT_simps
named_theorems smc_CAT_intros
subsectionβΉDefinition and elementary propertiesβΊ
definition smc_CAT :: "V β V"
where "smc_CAT Ξ± =
[
set {β. category Ξ± β},
all_cfs Ξ±,
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦),
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_CAT Ξ±). ππβ¦0β¦ ββ©Cβ©F ππβ¦1β©ββ¦)
]β©β"
textβΉComponents.βΊ
lemma smc_CAT_components:
shows "smc_CAT Ξ±β¦Objβ¦ = set {β. category Ξ± β}"
and "smc_CAT Ξ±β¦Arrβ¦ = all_cfs Ξ±"
and "smc_CAT Ξ±β¦Domβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦)"
and "smc_CAT Ξ±β¦Codβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦)"
and "smc_CAT Ξ±β¦Compβ¦ = (Ξ»ππββ©βcomposable_arrs (dg_CAT Ξ±). ππβ¦0β¦ ββ©Cβ©F ππβ¦1β©ββ¦)"
unfolding smc_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smc_dg_CAT: "smc_dg (smc_CAT Ξ±) = dg_CAT Ξ±"
proof(rule vsv_eqI)
show "vsv (smc_dg (smc_CAT Ξ±))" unfolding smc_dg_def by auto
show "vsv (dg_CAT Ξ±)" unfolding dg_CAT_def by auto
have dom_lhs: "πβ©β (smc_dg (smc_CAT Ξ±)) = 4β©β"
unfolding smc_dg_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (dg_CAT Ξ±) = 4β©β"
unfolding dg_CAT_def by (simp add: nat_omega_simps)
show "πβ©β (smc_dg (smc_CAT Ξ±)) = πβ©β (dg_CAT Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "π ββ©β πβ©β (smc_dg (smc_CAT Ξ±)) βΉ smc_dg (smc_CAT Ξ±)β¦πβ¦ = dg_CAT Ξ±β¦πβ¦"
for π
by
(
unfold dom_lhs,
elim_in_numeral,
unfold smc_dg_def dg_field_simps smc_CAT_def dg_CAT_def
)
(auto simp: nat_omega_simps)
qed
lemmas_with [folded smc_dg_CAT, unfolded slicing_simps]:
smc_CAT_ObjI = dg_CAT_ObjI
and smc_CAT_ObjD = dg_CAT_ObjD
and smc_CAT_ObjE = dg_CAT_ObjE
and smc_CAT_Obj_iff[smc_CAT_simps] = dg_CAT_Obj_iff
and smc_CAT_Dom_app[smc_CAT_simps] = dg_CAT_Dom_app
and smc_CAT_Cod_app[smc_CAT_simps] = dg_CAT_Cod_app
and smc_CAT_is_arrI = dg_CAT_is_arrI
and smc_CAT_is_arrD = dg_CAT_is_arrD
and smc_CAT_is_arrE = dg_CAT_is_arrE
and smc_CAT_is_arr_iff[smc_CAT_simps] = dg_CAT_is_arr_iff
subsectionβΉComposable arrowsβΊ
lemma smc_CAT_composable_arrs_dg_CAT:
"composable_arrs (dg_CAT Ξ±) = composable_arrs (smc_CAT Ξ±)"
unfolding composable_arrs_def smc_dg_CAT[symmetric] slicing_simps by auto
lemma smc_CAT_Comp:
"smc_CAT Ξ±β¦Compβ¦ = (Ξ»ππββ©βcomposable_arrs (smc_CAT Ξ±). ππβ¦0β¦ ββ©Sβ©Mβ©Cβ©F ππβ¦1β©ββ¦)"
unfolding smc_CAT_components smc_CAT_composable_arrs_dg_CAT ..
subsectionβΉCompositionβΊ
lemma smc_CAT_Comp_app[smc_CAT_simps]:
assumes "π : π
β¦βsmc_CAT Ξ±β β" and "π : π β¦βsmc_CAT Ξ±β π
"
shows "π ββ©Aβsmc_CAT Ξ±β π = π ββ©Sβ©Mβ©Cβ©F π"
proof-
from assms have "[π, π]β©β ββ©β composable_arrs (smc_CAT Ξ±)"
by (auto simp: smc_cs_intros)
then show "π ββ©Aβsmc_CAT Ξ±β π = π ββ©Sβ©Mβ©Cβ©F π"
unfolding smc_CAT_Comp by (simp add: nat_omega_simps)
qed
lemma smc_CAT_Comp_vdomain: "πβ©β (smc_CAT Ξ±β¦Compβ¦) = composable_arrs (smc_CAT Ξ±)"
unfolding smc_CAT_Comp by auto
lemma smc_CAT_Comp_vrange: "ββ©β (smc_CAT Ξ±β¦Compβ¦) ββ©β all_cfs Ξ±"
proof(rule vsubsetI)
fix β assume "β ββ©β ββ©β (smc_CAT Ξ±β¦Compβ¦)"
then obtain ππ
where β_def: "β = smc_CAT Ξ±β¦Compβ¦β¦ππβ¦"
and "ππ ββ©β πβ©β (smc_CAT Ξ±β¦Compβ¦)"
by (auto simp: smc_CAT_components intro: smc_cs_intros)
then obtain π π π π
β
where "ππ = [π, π]β©β"
and π: "π : π
β¦βsmc_CAT Ξ±β β"
and π: "π : π β¦βsmc_CAT Ξ±β π
"
by (auto simp: smc_CAT_Comp_vdomain)
with β_def have β_def': "β = π ββ©Aβsmc_CAT Ξ±β π" by simp
from π π show "β ββ©β all_cfs Ξ±"
unfolding β_def' by (auto simp: smc_CAT_simps intro: cat_cs_intros)
qed
subsectionβΉβΉCATβΊ is a categoryβΊ
lemma (in π΅) tiny_semicategory_smc_CAT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_semicategory Ξ² (smc_CAT Ξ±)"
proof(intro tiny_semicategoryI, unfold smc_CAT_is_arr_iff)
show "vfsequence (smc_CAT Ξ±)" unfolding smc_CAT_def by auto
show "vcard (smc_CAT Ξ±) = 5β©β"
unfolding smc_CAT_def by (simp add: nat_omega_simps)
show "(ππ ββ©β πβ©β (smc_CAT Ξ±β¦Compβ¦)) β·
(βπ π π
β π. ππ = [π, π]β©β β§ π : π
β¦β¦β©CβΞ±β β β§ π : π β¦β¦β©CβΞ±β π
)"
for ππ
unfolding smc_CAT_Comp_vdomain
proof
show "ππ ββ©β composable_arrs (smc_CAT Ξ±) βΉ
βπ π π
β π. ππ = [π, π]β©β β§ π : π
β¦β¦β©CβΞ±β β β§ π : π β¦β¦β©CβΞ±β π
"
by (elim composable_arrsE) (auto simp: smc_CAT_is_arr_iff)
next
assume "βπ π π
β π. ππ = [π, π]β©β β§ π : π
β¦β¦β©CβΞ±β β β§ π : π β¦β¦β©CβΞ±β π
"
with smc_CAT_is_arr_iff show "ππ ββ©β composable_arrs (smc_CAT Ξ±)"
unfolding smc_CAT_Comp_vdomain by (auto intro: smc_cs_intros)
qed
show "β¦ π : π
β¦β¦β©CβΞ±β β; π : π β¦β¦β©CβΞ±β π
β§ βΉ
π ββ©Aβsmc_CAT Ξ±β π : π β¦β¦β©CβΞ±β β"
for π π
β π π
by (cs_concl cs_simp: smc_CAT_simps cs_intro: cat_cs_intros)
fix β β π π π
π π
assume "β : β β¦β¦β©CβΞ±β π" "π : π
β¦β¦β©CβΞ±β β" "π : π β¦β¦β©CβΞ±β π
"
moreover then have "π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β" "β ββ©Cβ©F π : π
β¦β¦β©CβΞ±β π"
by (cs_concl cs_simp: smc_CAT_simps cs_intro: cat_cs_intros)+
ultimately show
"β ββ©Aβsmc_CAT Ξ±β π ββ©Aβsmc_CAT Ξ±β π = β ββ©Aβsmc_CAT Ξ±β (π ββ©Aβsmc_CAT Ξ±β π)"
by (simp add: smc_CAT_is_arr_iff smc_CAT_Comp_app cf_comp_assoc)
qed (auto simp: assms smc_dg_CAT tiny_category_dg_CAT smc_CAT_components)
subsectionβΉInitial objectβΊ
lemma (in π΅) smc_CAT_obj_initialI: "obj_initial (smc_CAT Ξ±) cat_0"
unfolding obj_initial_def
proof(intro obj_terminalI, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
show "category Ξ± cat_0" by (intro category_cat_0)
fix π assume "category Ξ± π"
then interpret category Ξ± π .
show "β!f. f : cat_0 β¦β¦β©CβΞ±β π"
proof
show cf_0: "cf_0 π : cat_0 β¦β¦β©CβΞ±β π"
by (simp add: cf_0_is_functor category_axioms is_ft_functor.axioms(1))
fix π assume prems: "π : cat_0 β¦β¦β©CβΞ±β π"
interpret π: is_functor Ξ± cat_0 π π using prems .
show "π = cf_0 π"
proof(rule cf_eqI)
show "π : cat_0 β¦β¦β©CβΞ±β π" by (simp add: prems)
from cf_0 show "cf_0 π : cat_0 β¦β¦β©CβΞ±β π"
unfolding smc_CAT_is_arr_iff by simp
have "πβ©β (πβ¦ObjMapβ¦) = 0" by (auto simp: cat_0_components cat_cs_simps)
then show "πβ¦ObjMapβ¦ = cf_0 πβ¦ObjMapβ¦"
using π.ObjMap.vbrelation_vintersection_vdomain
by (auto simp: cf_0_components)
have "πβ©β (πβ¦ArrMapβ¦) = 0" by (auto simp: cat_0_components cat_cs_simps)
with π.ArrMap.vbrelation_vintersection_vdomain show
"πβ¦ArrMapβ¦ = cf_0 πβ¦ArrMapβ¦"
by (auto simp: cf_0_components)
qed (simp_all add: cf_0_components)
qed
qed
lemma (in π΅) smc_CAT_obj_initialD:
assumes "obj_initial (smc_CAT Ξ±) π"
shows "π = cat_0"
using assms unfolding obj_initial_def
proof(elim obj_terminalE, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
assume prems:
"category Ξ± π"
"category Ξ± π
βΉ β!π. π : π β¦β¦β©CβΞ±β π
"
for π
from prems(2)[OF category_cat_0] obtain π where π: "π : π β¦β¦β©CβΞ±β cat_0"
by meson
interpret π: is_functor Ξ± π cat_0 π by (rule π)
have "ββ©β (πβ¦ObjMapβ¦) ββ©β 0"
unfolding cat_0_components(1)[symmetric] by (simp add: π.cf_ObjMap_vrange)
then have "πβ¦ObjMapβ¦ = 0" by (auto intro: π.ObjMap.vsv_vrange_vempty)
with π.cf_ObjMap_vdomain have Obj[simp]: "πβ¦Objβ¦ = 0" by auto
have "ββ©β (πβ¦ArrMapβ¦) ββ©β 0"
unfolding cat_0_components(2)[symmetric] by (simp add: π.cf_ArrMap_vrange)
then have "πβ¦ArrMapβ¦ = 0" by (auto intro: π.ArrMap.vsv_vrange_vempty)
with π.cf_ArrMap_vdomain have Arr[simp]: "πβ¦Arrβ¦ = 0" by auto
from π.HomDom.Dom.vdomain_vrange_is_vempty have [simp]: "πβ¦Domβ¦ = 0"
by (fastforce simp: π.HomDom.cat_Dom_vempty_if_Arr_vempty)
from π.HomDom.Cod.vdomain_vrange_is_vempty have [simp]: "πβ¦Codβ¦ = 0"
by (fastforce simp: π.HomDom.cat_Cod_vempty_if_Arr_vempty)
from Arr have "πβ¦Arrβ¦ ^β©Γ 2β©β = 0" by (simp add: vcpower_of_vempty)
with π.HomDom.Comp.pnop_vdomain have "πβ©β (πβ¦Compβ¦) = 0" by simp
with π.HomDom.Comp.vdomain_vrange_is_vempty have [simp]: "πβ¦Compβ¦ = 0"
by (auto intro: π.HomDom.Comp.vsv_vrange_vempty)
have "πβ©β (πβ¦CIdβ¦) = 0"
by (simp add: π.HomDom.cat_CId_vdomain)
with π.HomDom.CId.vdomain_vrange_is_vempty π.HomDom.CId.vsv_vrange_vempty
have [simp]: "πβ¦CIdβ¦ = 0"
by simp
show "π = cat_0"
by (rule cat_eqI[of Ξ±])
(simp_all add: prems(1) cat_0_components category_cat_0)
qed
lemma (in π΅) smc_CAT_obj_initialE:
assumes "obj_initial (smc_CAT Ξ±) π"
obtains "π = cat_0"
using assms by (auto dest: smc_CAT_obj_initialD)
lemma (in π΅) smc_CAT_obj_initial_iff[smc_CAT_simps]:
"obj_initial (smc_CAT Ξ±) π β· π = cat_0"
using smc_CAT_obj_initialI smc_CAT_obj_initialD by auto
subsectionβΉTerminal objectβΊ
lemma (in π΅) smc_CAT_obj_terminalI:
assumes "a ββ©β Vset Ξ±" and "f ββ©β Vset Ξ±"
shows "obj_terminal (smc_CAT Ξ±) (cat_1 a f)"
proof(intro obj_terminalI, unfold smc_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
fix π assume prems: "category Ξ± π"
then interpret category Ξ± π .
show "β!π'. π' : π β¦β¦β©CβΞ±β cat_1 a f"
proof
show cf_1: "cf_const π (cat_1 a f) a : π β¦β¦β©CβΞ±β cat_1 a f"
by (rule cf_const_is_functor)
(auto simp: assms prems category_cat_1 cat_1_components)
fix π' assume "π' : π β¦β¦β©CβΞ±β cat_1 a f"
then interpret π': is_functor Ξ± π βΉcat_1 a fβΊ π' .
show "π' = cf_const π (cat_1 a f) a"
proof(rule cf_eqI, unfold dghm_const_components)
from cf_1 show "cf_const π (cat_1 a f) a : π β¦β¦β©CβΞ±β cat_1 a f" by simp
show "π'β¦ObjMapβ¦ = vconst_on (πβ¦Objβ¦) a"
proof(casesβΉπβ¦Objβ¦ = 0βΊ)
case True
with π'.ObjMap.vbrelation_vintersection_vdomain have "π'β¦ObjMapβ¦ = 0"
by (auto simp: cat_cs_simps)
with True show ?thesis by simp
next
case False
then have "πβ©β (π'β¦ObjMapβ¦) β 0" by (auto simp: cat_cs_simps)
then have "ββ©β (π'β¦ObjMapβ¦) β 0"
by (simp add: π'.ObjMap.vsv_vdomain_vempty_vrange_vempty)
moreover from π'.cf_ObjMap_vrange have "ββ©β (π'β¦ObjMapβ¦) ββ©β set {a}"
by (simp add: cat_1_components)
ultimately have "ββ©β (π'β¦ObjMapβ¦) = set {a}" by auto
then show ?thesis
by (intro vsv.vsv_is_vconst_onI) (auto simp: cat_cs_simps)
qed
show "π'β¦ArrMapβ¦ = vconst_on (πβ¦Arrβ¦) (cat_1 a fβ¦CIdβ¦β¦aβ¦)"
proof(casesβΉπβ¦Arrβ¦ = 0βΊ)
case True
with
π'.ArrMap.vdomain_vrange_is_vempty
vsv.vsv_vrange_vempty[OF π'.cf_ArrMap_vsv]
have "π'β¦ArrMapβ¦ = 0"
by (auto simp: cat_cs_simps)
with True show ?thesis by simp
next
case False
then have "πβ©β (π'β¦ArrMapβ¦) β 0" by (auto simp: cat_cs_simps)
then have "ββ©β (π'β¦ArrMapβ¦) β 0"
by (simp add: π'.ArrMap.vsv_vdomain_vempty_vrange_vempty)
moreover from π'.cf_ArrMap_vrange have "ββ©β (π'β¦ArrMapβ¦) ββ©β set {f}"
by (simp add: cat_1_components)
ultimately have "ββ©β (π'β¦ArrMapβ¦) = set {f}" by auto
then show ?thesis
by
(
cs_concl
cs_simp: V_cs_simps cat_cs_simps cat_1_components
cs_intro: V_cs_intros vsv.vsv_is_vconst_onI
)+
qed
qed (auto intro: cat_cs_intros)
qed
qed (simp add: assms category_cat_1)
lemma (in π΅) smc_CAT_obj_terminalE:
assumes "obj_terminal (smc_CAT Ξ±) π
"
obtains a f where "a ββ©β Vset Ξ±" and "f ββ©β Vset Ξ±" and "π
= cat_1 a f"
using assms
proof(elim obj_terminalE, unfold cat_op_simps smc_CAT_is_arr_iff smc_CAT_Obj_iff)
assume prems: "category Ξ± π
" "category Ξ± π βΉ β!π. π : π β¦β¦β©CβΞ±β π
" for π
interpret π
: category Ξ± π
by (rule prems(1))
obtain a where π
_Obj: "π
β¦Objβ¦ = set {a}" and a: "a ββ©β Vset Ξ±"
proof-
have cat_1: "category Ξ± (cat_1 0 0)" by (rule category_cat_1) auto
from prems(2)[OF cat_1] obtain π
where π: "π : cat_1 0 0 β¦β¦β©CβΞ±β π
"
and ππ: "π : cat_1 0 0 β¦β¦β©CβΞ±β π
βΉ π = π" for π
by fastforce
interpret π: is_functor Ξ± βΉcat_1 0 0βΊ π
π by (rule π)
have "πβ©β (πβ¦ObjMapβ¦) = set {0}" by (simp add: cat_1_components cat_cs_simps)
then obtain a where vrange_π[simp]: "ββ©β (πβ¦ObjMapβ¦) = set {a}"
by (auto intro: π.ObjMap.vsv_vdomain_vsingleton_vrange_vsingleton)
with π
.cat_Obj_vsubset_Vset π.cf_ObjMap_vrange have [simp]: "a ββ©β Vset Ξ±"
by auto
from π.cf_ObjMap_vrange have "set {a} ββ©β π
β¦Objβ¦" by simp
moreover have "π
β¦Objβ¦ ββ©β set {a}"
proof(rule ccontr)
assume "Β¬π
β¦Objβ¦ ββ©β set {a}"
then obtain b where ba: "b β a" and b: "b ββ©β π
β¦Objβ¦" by force
have "cf_const (cat_1 0 0) π
b : cat_1 0 0 β¦β¦β©CβΞ±β π
"
by (rule cf_const_is_functor)
(simp_all add: π
.category_axioms category_cat_1 b)
then have π_def: "cf_const (cat_1 0 0) π
b = π" by (rule ππ)
have "ββ©β (cf_const (cat_1 0 0) π
bβ¦ObjMapβ¦) = set {b}"
unfolding dghm_const_components cat_1_components by simp
with vrange_π ba show False unfolding π_def by simp
qed
ultimately have "π
β¦Objβ¦ = set {a}" by simp
with that show ?thesis by simp
qed
have π
_Arr: "π
β¦Arrβ¦ = set {π
β¦CIdβ¦β¦aβ¦}"
proof(rule vsubset_antisym)
from π
_Obj show "set {π
β¦CIdβ¦β¦aβ¦} ββ©β π
β¦Arrβ¦"
by (blast intro: π
.cat_is_arrD(1) cat_cs_intros)
show "π
β¦Arrβ¦ ββ©β set {π
β¦CIdβ¦β¦aβ¦}"
proof(intro vsubsetI)
fix f assume "f ββ©β π
β¦Arrβ¦"
with π
_Obj have f: "f : a β¦βπ
β a"
by (metis π
.cat_is_arrD(2,3) is_arrI vsingleton_iff)
from f have "cf_const π
π
a : π
β¦β¦β©CβΞ±β π
"
by (intro cf_const_is_functor) (auto simp: π
.category_axioms)
moreover from f have "cf_id π
: π
β¦β¦β©CβΞ±β π
"
by (intro category.cat_cf_id_is_functor)
(auto simp: π
.category_axioms)
ultimately have "cf_const π
π
a = cf_id π
"
by (metis prems(2) π
.category_axioms)
moreover from f have "cf_const π
π
aβ¦ArrMapβ¦β¦fβ¦ = π
β¦CIdβ¦β¦aβ¦"
by (simp add: βΉf ββ©β π
β¦Arrβ¦βΊ dghm_const_ArrMap_app)
moreover from f have "cf_id π
β¦ArrMapβ¦β¦fβ¦ = f"
unfolding dghm_id_components by (simp add: cat_cs_intros)
ultimately show "f ββ©β set {π
β¦CIdβ¦β¦aβ¦}" by simp
qed
qed
have "π
= cat_1 a (π
β¦CIdβ¦β¦aβ¦)"
proof(rule cat_eqI[of Ξ±], unfold cat_1_components)
from π
.cat_Arr_vsubset_Vset π
_Arr show "category Ξ± (cat_1 a (π
β¦CIdβ¦β¦aβ¦))"
by (intro category_cat_1) (auto simp: a)
show "π
β¦Arrβ¦ = set {π
β¦CIdβ¦β¦aβ¦}" by (simp add: π
_Arr)
then have "πβ©β (π
β¦Domβ¦) = set {π
β¦CIdβ¦β¦aβ¦}"
by (simp add: cat_cs_simps cat_cs_intros)
moreover have "ββ©β (π
β¦Domβ¦) = set {a}"
using π
.cat_Dom_vrange π
.cat_CId_is_arr π
.cat_Dom_vdomain
by (auto simp: π
_Obj elim: π
.Dom.vbrelation_vinE)
ultimately show "π
β¦Domβ¦ = set {β¨π
β¦CIdβ¦β¦aβ¦, aβ©}"
using π
.Dom.vsv_vdomain_vrange_vsingleton by simp
have "πβ©β (π
β¦Codβ¦) = set {π
β¦CIdβ¦β¦aβ¦}"
by (simp add: π
_Arr cat_cs_simps)
moreover have "ββ©β (π
β¦Codβ¦) = set {a}"
using π
.cat_Cod_vrange π
.cat_CId_is_arr π
.cat_Cod_vdomain
by (auto simp: π
_Obj elim: π
.Cod.vbrelation_vinE)
ultimately show "π
β¦Codβ¦ = set {β¨π
β¦CIdβ¦β¦aβ¦, aβ©}"
by (auto intro: π
.Cod.vsv_vdomain_vrange_vsingleton)
show "π
β¦Compβ¦ = set {β¨[π
β¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦aβ¦]β©β, π
β¦CIdβ¦β¦aβ¦β©}"
proof(rule vsv_eqI)
show dom:
"πβ©β (π
β¦Compβ¦) = πβ©β (set {β¨[π
β¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦aβ¦]β©β, π
β¦CIdβ¦β¦aβ¦β©})"
unfolding vdomain_vsingleton
proof(rule vsubset_antisym)
show "πβ©β (π
β¦Compβ¦) ββ©β set {[π
β¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦aβ¦]β©β}"
by (intro vsubsetI)
(metis π
.cat_Comp_vdomain π
_Arr vsingleton_iff π
.cat_is_arrD(1))
show "set {[π
β¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦aβ¦]β©β} ββ©β πβ©β (π
β¦Compβ¦)"
by
(
metis
π
_Obj vsingleton_iff
π
.cat_CId_is_arr
π
.cat_Comp_vdomainI
vsubset_vsingleton_left
)
qed
have "π
β¦CIdβ¦β¦aβ¦ ββ©Aβπ
β π
β¦CIdβ¦β¦aβ¦ = π
β¦CIdβ¦β¦aβ¦"
by (metis π
_Obj π
.cat_CId_is_arr π
.cat_CId_left_left vsingletonI)
then show "a' ββ©β πβ©β (π
β¦Compβ¦) βΉ
π
β¦Compβ¦β¦a'β¦ = set {β¨[π
β¦CIdβ¦β¦aβ¦, π
β¦CIdβ¦β¦aβ¦]β©β, π
β¦CIdβ¦β¦aβ¦β©}β¦a'β¦"
for a'
unfolding dom by simp
qed (auto simp: π
_Obj π
_Arr)
have "πβ©β (π
β¦CIdβ¦) = set {a}" by (simp add: π
_Obj π
.cat_CId_vdomain)
moreover then have "ββ©β (π
β¦CIdβ¦) = set {π
β¦CIdβ¦β¦aβ¦}"
by
(
metis
π
.CId.vdomain_atE
π
.CId.vsv_vdomain_vsingleton_vrange_vsingleton
vsingleton_iff
)
ultimately show "π
β¦CIdβ¦ = set {β¨a, π
β¦CIdβ¦β¦aβ¦β©}"
by (blast intro: π
.CId.vsv_vdomain_vrange_vsingleton)
qed (auto simp: π
_Obj cat_cs_intros)
with a that π
.cat_Arr_vsubset_Vset π
_Arr show ?thesis by auto
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_CAT
sectionβΉβΉCATβΊβΊ
theory CZH_ECAT_CAT
imports CZH_SMC_CAT
begin
subsectionβΉBackgroundβΊ
textβΉ
The subsection presents the theory of the categories of βΉΞ±βΊ-categories.
It continues the development that was initiated in sections
\ref{sec:dg_CAT}-\ref{sec:smc_CAT}.
βΊ
named_theorems cat_CAT_simps
named_theorems cat_CAT_intros
subsectionβΉDefinition and elementary propertiesβΊ
definition cat_CAT :: "V β V"
where "cat_CAT Ξ± =
[
set {β. category Ξ± β},
all_cfs Ξ±,
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦),
(Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_CAT Ξ±). ππβ¦0β¦ ββ©Cβ©F ππβ¦1β©ββ¦),
(Ξ»βββ©βset {β. category Ξ± β}. cf_id β)
]β©β"
textβΉComponents.βΊ
lemma cat_CAT_components:
shows "cat_CAT Ξ±β¦Objβ¦ = set {β. category Ξ± β}"
and "cat_CAT Ξ±β¦Arrβ¦ = all_cfs Ξ±"
and "cat_CAT Ξ±β¦Domβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomDomβ¦)"
and "cat_CAT Ξ±β¦Codβ¦ = (Ξ»πββ©βall_cfs Ξ±. πβ¦HomCodβ¦)"
and "cat_CAT Ξ±β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_CAT Ξ±). ππβ¦0β¦ ββ©Cβ©F ππβ¦1β©ββ¦)"
and "cat_CAT Ξ±β¦CIdβ¦ = (Ξ»βββ©βset {β. category Ξ± β}. cf_id β)"
unfolding cat_CAT_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_CAT: "cat_smc (cat_CAT Ξ±) = smc_CAT Ξ±"
proof(rule vsv_eqI)
have dom_lhs: "πβ©β (cat_smc (cat_CAT Ξ±)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_CAT Ξ±) = 5β©β"
unfolding smc_CAT_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_CAT Ξ±)) = πβ©β (smc_CAT Ξ±)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_CAT Ξ±)) βΉ cat_smc (cat_CAT Ξ±)β¦aβ¦ = smc_CAT Ξ±β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_CAT_def smc_CAT_def
)
(auto simp: nat_omega_simps)
qed (auto simp: cat_smc_def smc_CAT_def)
lemmas_with [folded cat_smc_CAT, unfolded slicing_simps]:
cat_CAT_ObjI = smc_CAT_ObjI
and cat_CAT_ObjD = smc_CAT_ObjD
and cat_CAT_ObjE = smc_CAT_ObjE
and cat_CAT_Obj_iff[cat_CAT_simps] = smc_CAT_Obj_iff
and cat_CAT_Dom_app[cat_CAT_simps] = smc_CAT_Dom_app
and cat_CAT_Cod_app[cat_CAT_simps] = smc_CAT_Cod_app
and cat_CAT_is_arrI = smc_CAT_is_arrI
and cat_CAT_is_arrD = smc_CAT_is_arrD
and cat_CAT_is_arrE = smc_CAT_is_arrE
and cat_CAT_is_arr_iff[cat_CAT_simps] = smc_CAT_is_arr_iff
lemmas_with [folded cat_smc_CAT, unfolded slicing_simps, unfolded cat_smc_CAT]:
cat_CAT_Comp_vdomain = smc_CAT_Comp_vdomain
and cat_CAT_composable_arrs_dg_CAT = smc_CAT_composable_arrs_dg_CAT
and cat_CAT_Comp = smc_CAT_Comp
and cat_CAT_Comp_app[cat_CAT_simps] = smc_CAT_Comp_app
and cat_CAT_Comp_vrange = smc_CAT_Comp_vrange
lemmas_with (in π΅) [folded cat_smc_CAT, unfolded slicing_simps]:
cat_CAT_obj_initialI = smc_CAT_obj_initialI
and cat_CAT_obj_initialD = smc_CAT_obj_initialD
and cat_CAT_obj_initialE = smc_CAT_obj_initialE
and cat_CAT_obj_initial_iff[cat_CAT_simps] = smc_CAT_obj_initial_iff
and cat_CAT_obj_terminalI = smc_CAT_obj_terminalI
and cat_CAT_obj_terminalE = smc_CAT_obj_terminalE
subsectionβΉIdentityβΊ
lemma cat_CAT_CId_app[cat_CAT_simps]:
assumes "category Ξ± β"
shows "cat_CAT Ξ±β¦CIdβ¦β¦ββ¦ = cf_id β"
using assms unfolding cat_CAT_components by simp
lemma cat_CAT_CId_vdomain: "πβ©β (cat_CAT Ξ±β¦CIdβ¦) = set {β. category Ξ± β}"
unfolding cat_CAT_components by auto
lemma cat_CAT_CId_vrange: "ββ©β (cat_CAT Ξ±β¦CIdβ¦) ββ©β all_cfs Ξ±"
proof(rule vsubsetI)
fix β assume "β ββ©β ββ©β (cat_CAT Ξ±β¦CIdβ¦)"
then obtain π
where β_def: "β = cat_CAT Ξ±β¦CIdβ¦β¦πβ¦"
and π: "π ββ©β πβ©β (cat_CAT Ξ±β¦CIdβ¦)"
unfolding cat_CAT_components by auto
from π have β_def': "β = cf_id π"
unfolding β_def cat_CAT_CId_vdomain by (auto simp: cat_CAT_CId_app)
from π category.cat_cf_id_is_functor show "β ββ©β all_cfs Ξ±"
unfolding β_def' cat_CAT_CId_vdomain by force
qed
subsectionβΉβΉCATβΊ is a categoryβΊ
lemma (in π΅) tiny_category_cat_CAT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² (cat_CAT Ξ±)"
proof(intro tiny_categoryI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "vfsequence (cat_CAT Ξ±)" unfolding cat_CAT_def by simp
show "vcard (cat_CAT Ξ±) = 6β©β"
unfolding cat_CAT_def by (simp add: nat_omega_simps)
show "π : π β¦βcat_CAT Ξ±β π
βΉ cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ ββ©Aβcat_CAT Ξ±β π = π"
for π π π
proof-
assume prems: "π : π β¦βcat_CAT Ξ±β π
"
then have b: "category Ξ± π
" unfolding cat_CAT_is_arr_iff by auto
with digraph.dg_dghm_id_is_dghm have
"cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ : π
β¦βcat_CAT Ξ±β π
"
by
(
simp add:
cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
)
with prems b show "cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ ββ©Aβcat_CAT Ξ±β π = π"
by
(
simp add:
cat_CAT_CId_app
cat_CAT_Comp_app
cat_CAT_is_arr_iff
is_functor.cf_cf_comp_cf_id_left
)
qed
show "π : π
β¦βcat_CAT Ξ±β β βΉ π ββ©Aβcat_CAT Ξ±β cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ = π"
for π π
β
proof-
assume prems: "π : π
β¦βcat_CAT Ξ±β β"
then have b: "category Ξ± π
" unfolding cat_CAT_is_arr_iff by auto
then have "cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ : π
β¦βcat_CAT Ξ±β π
"
by
(
simp add:
cat_CAT_CId_app cat_CAT_is_arrI category.cat_cf_id_is_functor
)
with prems b show "π ββ©Aβcat_CAT Ξ±β cat_CAT Ξ±β¦CIdβ¦β¦π
β¦ = π"
by
(
auto
simp: cat_CAT_CId_app cat_CAT_Comp_app cat_CAT_is_arr_iff
intro: is_functor.cf_cf_comp_cf_id_right
)
qed
qed
(
simp_all add:
assms
cat_smc_CAT
cat_CAT_components
π΅.intro
π΅_Limit_Ξ±Ο
π΅_Ο_Ξ±Ο
cat_CAT_is_arr_iff
tiny_semicategory_smc_CAT
category.cat_cf_id_is_functor
)
lemmas [cat_cs_intros] = π΅.tiny_category_cat_CAT
subsectionβΉIsomorphismβΊ
lemma (in π΅) cat_CAT_is_arr_isomorphismI:
assumes "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
shows "π : π β¦β©iβ©sβ©oβcat_CAT Ξ±β π
"
proof(intro is_arr_isomorphismI is_inverseI)
from assms show π: "π : π β¦βcat_CAT Ξ±β π
"
unfolding cat_CAT_is_arr_iff by auto
note iso_thms = is_iso_functor_is_arr_isomorphism[OF assms]
from iso_thms(1) show inv_π: "inv_cf π : π
β¦βcat_CAT Ξ±β π"
unfolding cat_CAT_is_arr_iff by auto
from assms show "π : π β¦βcat_CAT Ξ±β π
"
unfolding cat_CAT_is_arr_iff by auto
from assms have π: "category Ξ± π" and π
: "category Ξ± π
" by auto
show "inv_cf π ββ©Aβcat_CAT Ξ±β π = cat_CAT Ξ±β¦CIdβ¦β¦πβ¦"
unfolding cat_CAT_CId_app[OF π] cat_CAT_Comp_app[OF inv_π π]
by (rule iso_thms(2))
show "π ββ©Aβcat_CAT Ξ±β inv_cf π = cat_CAT Ξ±β¦CIdβ¦β¦π
β¦"
unfolding cat_CAT_CId_app[OF π
] cat_CAT_Comp_app[OF π inv_π]
by (rule iso_thms(3))
qed
lemma (in π΅) cat_CAT_is_arr_isomorphismD:
assumes "π : π β¦β©iβ©sβ©oβcat_CAT Ξ±β π
"
shows "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
proof-
from is_arr_isomorphismD[OF assms] have π: "π : π β¦βcat_CAT Ξ±β π
"
and "(βπ. is_inverse (cat_CAT Ξ±) π π)"
by simp_all
then obtain π where "is_inverse (cat_CAT Ξ±) π π" by clarsimp
then obtain π' π
' where π': "π : π
' β¦βcat_CAT Ξ±β π'"
and π': "π : π' β¦βcat_CAT Ξ±β π
'"
and ππ: "π ββ©Aβcat_CAT Ξ±β π = cat_CAT Ξ±β¦CIdβ¦β¦π'β¦"
and ππ: "π ββ©Aβcat_CAT Ξ±β π = cat_CAT Ξ±β¦CIdβ¦β¦π
'β¦"
by auto
from π π' have π': "π' = π" and π
': "π
' = π
" by auto
from π have π: "π : π β¦β¦β©CβΞ±β π
" unfolding cat_CAT_is_arr_iff by simp
then have π: "category Ξ± π" and π
: "category Ξ± π
" by auto
from π' have "π : π
β¦β¦β©CβΞ±β π"
unfolding π' π
' cat_CAT_is_arr_iff by simp
moreover from ππ have "π ββ©Cβ©F π = cf_id π"
unfolding π' cat_CAT_Comp_app[OF π' π'] cat_CAT_CId_app[OF π]
by simp
moreover from ππ have "π ββ©Cβ©F π = cf_id π
"
unfolding π
' cat_CAT_Comp_app[OF π' π'] cat_CAT_CId_app[OF π
]
by simp
ultimately show ?thesis
using π by (elim is_arr_isomorphism_is_iso_functor)
qed
lemma (in π΅) cat_CAT_is_arr_isomorphismE:
assumes "π : π β¦β©iβ©sβ©oβcat_CAT Ξ±β π
"
obtains "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
using assms by (auto dest: cat_CAT_is_arr_isomorphismD)
lemma (in π΅) cat_CAT_is_arr_isomorphism_iff[cat_CAT_simps]:
"π : π β¦β©iβ©sβ©oβcat_CAT Ξ±β π
β· π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
using cat_CAT_is_arr_isomorphismI cat_CAT_is_arr_isomorphismD by auto
subsectionβΉIsomorphic objectsβΊ
lemma (in π΅) cat_CAT_obj_isoI:
assumes "π ββ©CβΞ±β π
"
shows "π ββ©oβ©bβ©jβcat_CAT Ξ±β π
"
proof-
from iso_categoryD[OF assms] obtain π where "π : π β¦β¦β©Cβ©.β©iβ©sβ©oβΞ±β π
"
by clarsimp
from cat_CAT_is_arr_isomorphismI[OF this] show ?thesis by (rule obj_isoI)
qed
lemma (in π΅) cat_CAT_obj_isoD:
assumes "π ββ©oβ©bβ©jβcat_CAT Ξ±β π
"
shows "π ββ©CβΞ±β π
"
proof-
from obj_isoD[OF assms] obtain π where "π : π β¦β©iβ©sβ©oβcat_CAT Ξ±β π
"
by clarsimp
from cat_CAT_is_arr_isomorphismD[OF this] show ?thesis by (rule iso_categoryI)
qed
lemma (in π΅) cat_CAT_obj_isoE:
assumes "π ββ©oβ©bβ©jβcat_CAT Ξ±β π
"
obtains "π ββ©CβΞ±β π
"
using assms by (auto simp: cat_CAT_obj_isoD)
lemma (in π΅) cat_CAT_obj_iso_iff[cat_CAT_simps]:
"π ββ©oβ©bβ©jβcat_CAT Ξ±β π
β· π ββ©CβΞ±β π
"
using cat_CAT_obj_isoI cat_CAT_obj_isoD by (intro iffI) auto
textβΉ\newpageβΊ
end
Theory CZH_DG_FUNCT
sectionβΉβΉFUNCTβΊ and βΉFunctβΊ as digraphs\label{sec:dg_FUNCT}βΊ
theory CZH_DG_FUNCT
imports
CZH_ECAT_Small_NTCF
CZH_Foundations.CZH_DG_Subdigraph
begin
subsectionβΉBackgroundβΊ
textβΉ
A general reference for this section is Chapter II-4 in
\cite{mac_lane_categories_2010}.
βΊ
named_theorems dg_FUNCT_cs_simps
named_theorems dg_FUNCT_cs_intros
named_theorems cat_map_cs_simps
named_theorems cat_map_cs_intros
subsectionβΉFunctor mapβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_map :: "V β V"
where "cf_map π = [πβ¦ObjMapβ¦, πβ¦ArrMapβ¦]β©β"
abbreviation cf_maps :: "V β V β V β V"
where "cf_maps Ξ± π π
β‘ set {cf_map π | π. π : π β¦β¦β©CβΞ±β π
}"
abbreviation tm_cf_maps :: "V β V β V β V"
where "tm_cf_maps Ξ± π π
β‘ set {cf_map π | π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
lemma tm_cf_maps_subset_cf_maps:
"{cf_map π | π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
} β {cf_map π | π. π : π β¦β¦β©CβΞ±β π
}"
by auto
textβΉComponents.βΊ
lemma cf_map_components[cat_map_cs_simps]:
shows "cf_map πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "cf_map πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
unfolding cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)
textβΉSequence characterization.βΊ
lemma dg_FUNCT_Obj_components:
shows "[FOM, FAM]β©ββ¦ObjMapβ¦ = FOM"
and "[FOM, FAM]β©ββ¦ArrMapβ¦ = FAM"
unfolding dghm_field_simps by (simp_all add: nat_omega_simps)
lemma cf_map_vfsequence[cat_map_cs_intros]: "vfsequence (cf_map π)"
unfolding cf_map_def by auto
lemma cf_map_vdomain[cat_map_cs_simps]: "πβ©β (cf_map π) = 2β©β"
unfolding cf_map_def by (simp add: nat_omega_simps)
lemma (in is_functor) cf_map_vsubset_cf: "cf_map π ββ©β π"
by (unfold cf_map_def, subst (3) cf_def)
(cs_concl cs_intro: vcons_vsubset' V_cs_intros)
textβΉSize.βΊ
lemma (in is_functor) cf_map_ObjMap_in_Vset:
assumes "Ξ± ββ©β Ξ²"
shows "cf_map πβ¦ObjMapβ¦ ββ©β Vset Ξ²"
using assms unfolding cf_map_components by (intro cf_ObjMap_in_Vset)
lemma (in is_tm_functor) tm_cf_map_ObjMap_in_Vset: "cf_map πβ¦ObjMapβ¦ ββ©β Vset Ξ±"
unfolding cf_map_components by (rule tm_cf_ObjMap_in_Vset)
lemma (in is_functor) cf_map_ArrMap_in_Vset:
assumes "Ξ± ββ©β Ξ²"
shows "cf_map πβ¦ArrMapβ¦ ββ©β Vset Ξ²"
using assms unfolding cf_map_components by (intro cf_ArrMap_in_Vset)
lemma (in is_tm_functor) tm_cf_map_ArrMap_in_Vset: "cf_map πβ¦ArrMapβ¦ ββ©β Vset Ξ±"
unfolding cf_map_components by (rule tm_cf_ArrMap_in_Vset)
lemma (in is_functor) cf_map_in_Vset_4: "cf_map π ββ©β Vset (Ξ± + 4β©β)"
proof-
note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
cf_ObjMap_vsubset_Vset
cf_ArrMap_vsubset_Vset
show ?thesis
by (subst cf_map_def, succ_of_numeral)
(
cs_concl
cs_simp: plus_V_succ_right V_cs_simps
cs_intro: cat_cs_intros V_cs_intros
)
qed
lemma (in is_tm_functor) tm_cf_map_in_Vset: "cf_map π ββ©β Vset Ξ±"
using tm_cf_ObjMap_in_Vset tm_cf_ArrMap_in_Vset unfolding cf_map_def
by (cs_concl cs_intro: V_cs_intros)
lemma (in is_functor) cf_map_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_map π ββ©β Vset Ξ²"
using assms cf_map_in_Vset_4 cf_map_vsubset_cf
by (auto intro!: cf_in_Vset)
lemma cf_maps_subset_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "{cf_map π | π. π : π β¦β¦β©CβΞ±β π
} β elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
fix x π assume x_def: "x = cf_map π" and π: "π : π β¦β¦β©CβΞ±β π
"
interpret is_functor Ξ± π π
π by (rule π)
show "x ββ©β Vset Ξ²" unfolding x_def by (rule cf_map_in_Vset[OF assms])
qed
lemma small_cf_maps[simp]: "small {cf_map π | π. π : π β¦β¦β©CβΞ±β π
}"
proof(cases βΉπ΅ Ξ±βΊ)
case True
from is_functor.cf_map_in_Vset show ?thesis
by (intro down[of _ βΉVset (Ξ± + Ο)βΊ])
(auto simp: True π΅.π΅_Limit_Ξ±Ο π΅.π΅_Ο_Ξ±Ο π΅.intro π΅.π΅_Ξ±_Ξ±Ο)
next
case False
then have "{cf_map π | π. π : π β¦β¦β©CβΞ±β π
} = {}" by auto
then show ?thesis by simp
qed
lemma small_tm_cf_maps[simp]: "small {cf_map π | π. π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
by (rule smaller_than_small[OF small_cf_maps tm_cf_maps_subset_cf_maps])
lemma (in π΅) cf_maps_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_maps Ξ± π π
ββ©β Vset Ξ²"
proof(rule vsubset_in_VsetI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "cf_maps Ξ± π π
ββ©β Vset (Ξ± + 4β©β)"
proof(intro vsubsetI)
fix π assume "π ββ©β cf_maps Ξ± π π
"
then obtain π π
π' where π_def: "π = cf_map π'" and π: "π' : π β¦β¦β©CβΞ±β π
"
by auto
interpret is_functor Ξ± π π
π' using π by simp
show "π ββ©β Vset (Ξ± + 4β©β)" unfolding π_def by (rule cf_map_in_Vset_4)
qed
from assms(2) show "Vset (Ξ± + 4β©β) ββ©β Vset Ξ²"
by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed
lemma (in π΅) tm_cf_maps_vsubset_Vset: "tm_cf_maps Ξ± π π
ββ©β Vset Ξ±"
proof(intro vsubsetI)
fix π assume "π ββ©β tm_cf_maps Ξ± π π
"
then obtain π π
π'
where π_def: "π = cf_map π'" and π: "π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by auto
then show "π ββ©β Vset Ξ±" by (force simp: is_tm_functor.tm_cf_map_in_Vset)
qed
textβΉRules.βΊ
lemma (in is_functor) cf_mapsI: "cf_map π ββ©β cf_maps Ξ± π π
"
by (auto intro: cat_cs_intros)
lemma (in is_tm_functor) tm_cf_mapsI: "cf_map π ββ©β tm_cf_maps Ξ± π π
"
by (auto intro: cat_small_cs_intros)
lemma (in is_functor) cf_mapsI':
assumes "π' = cf_map π"
shows "π' ββ©β cf_maps Ξ± π π
"
unfolding assms by (rule cf_mapsI)
lemma (in is_tm_functor) tm_cf_mapsI':
assumes "π' = cf_map π"
shows "π' ββ©β tm_cf_maps Ξ± π π
"
unfolding assms by (rule tm_cf_mapsI)
lemmas [cat_map_cs_intros] =
is_functor.cf_mapsI
lemmas cf_mapsI'[cat_map_cs_intros] =
is_functor.cf_mapsI'[rotated]
lemmas [cat_map_cs_intros] =
is_tm_functor.tm_cf_mapsI
lemmas tm_cf_mapsI'[cat_map_cs_intros] =
is_tm_functor.tm_cf_mapsI'[rotated]
lemma cf_mapsE[elim]:
assumes "π ββ©β cf_maps Ξ± π π
"
obtains π where "π = cf_map π" and "π : π β¦β¦β©CβΞ±β π
"
using assms by force
lemma tm_cf_mapsE[elim]:
assumes "π ββ©β tm_cf_maps Ξ± π π
"
obtains π where "π = cf_map π" and "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
using assms by force
textβΉThe opposite functor map.βΊ
lemma (in is_functor) cf_map_op_cf[cat_op_simps]: "cf_map (op_cf π) = cf_map π"
proof(rule vsv_eqI, unfold cat_map_cs_simps)
show "a ββ©β 2β©β βΉ cf_map (op_cf π)β¦aβ¦ = cf_map πβ¦aβ¦" for a
by
(
elim_in_numeral,
unfold dghm_field_simps[symmetric] cf_map_components cat_op_simps
)
simp_all
qed (auto intro: cat_map_cs_intros)
lemmas [cat_op_simps] = is_functor.cf_map_op_cf
textβΉElementary properties.βΊ
lemma tm_cf_maps_vsubset_cf_maps: "tm_cf_maps Ξ± π π
ββ©β cf_maps Ξ± π π
"
using tm_cf_maps_subset_cf_maps by simp
lemma tm_cf_maps_in_cf_maps:
assumes "π ββ©β tm_cf_maps Ξ± π π
"
shows "π ββ©β cf_maps Ξ± π π
"
using assms tm_cf_maps_vsubset_cf_maps[of Ξ± π π
] by blast
lemma cf_map_inj:
assumes "cf_map π = cf_map π" and "π : π β¦β¦β©CβΞ±β π
" and "π : π β¦β¦β©CβΞ±β π
"
shows "π = π"
proof(rule cf_eqI)
from assms(1) have ObjMap: "cf_map πβ¦ObjMapβ¦ = cf_map πβ¦ObjMapβ¦"
and ArrMap: "cf_map πβ¦ArrMapβ¦ = cf_map πβ¦ArrMapβ¦"
by auto
from ObjMap show "πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦" unfolding cf_map_components by simp
from ArrMap show "πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦" unfolding cf_map_components by simp
qed (auto intro: assms(2,3))
lemma cf_map_eq_iff[cat_map_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β π
" and "π : π β¦β¦β©CβΞ±β π
"
shows "cf_map π = cf_map π β· π = π"
using cf_map_inj[OF _ assms] by auto
lemma cf_map_eqI:
assumes "π ββ©β cf_maps Ξ± π π
"
and "π ββ©β cf_maps Ξ± π π
"
and "πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
shows "π = π"
proof-
from assms(1) obtain π'
where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π
"
by auto
from assms(2) obtain π'
where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π
"
by auto
show ?thesis
proof(rule vsv_eqI, unfold π_def π_def)
show "a ββ©β πβ©β (cf_map π') βΉ cf_map π'β¦aβ¦ = cf_map π'β¦aβ¦" for a
by
(
unfold cf_map_vdomain,
elim_in_numeral,
insert assms(3,4),
unfold π_def π_def
)
(auto simp: dghm_field_simps)
qed (auto simp: cat_map_cs_simps intro: cat_map_cs_intros)
qed
subsectionβΉConversion of a functor map to a functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_of_cf_map :: "V β V β V β V"
where "cf_of_cf_map π π
π = [πβ¦ObjMapβ¦, πβ¦ArrMapβ¦, π, π
]β©β"
textβΉComponents.βΊ
lemma cf_of_cf_map_components[cat_map_cs_simps]:
shows "cf_of_cf_map π π
πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "cf_of_cf_map π π
πβ¦ArrMapβ¦ = πβ¦ArrMapβ¦"
and "cf_of_cf_map π π
πβ¦HomDomβ¦ = π"
and "cf_of_cf_map π π
πβ¦HomCodβ¦ = π
"
unfolding cf_of_cf_map_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉThe conversion of a functor map to a functor is a functorβΊ
lemma (in is_functor) cf_of_cf_map_is_functor:
"cf_of_cf_map π π
(cf_map π) : π β¦β¦β©CβΞ±β π
"
proof(rule is_functorI')
show "vfsequence (cf_of_cf_map π π
(cf_map π))"
unfolding cf_of_cf_map_def by simp
show "vcard (cf_of_cf_map π π
(cf_map π)) = 4β©β"
unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦fβ¦ :
cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦aβ¦ β¦βπ
β
cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βπβ b" for a b f
unfolding cf_of_cf_map_components cf_map_components
using is_functor_axioms that
by (cs_concl cs_intro: cat_cs_intros)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦g ββ©Aβπβ fβ¦ =
cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β
cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βπβ c" and "f : a β¦βπβ b" for b c g a f
using is_functor_axioms that
unfolding cf_of_cf_map_components cf_map_components
by (cs_concl cs_simp: cat_cs_simps)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ =
π
β¦CIdβ¦β¦cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β πβ¦Objβ¦" for c
using is_functor_axioms that
unfolding cf_of_cf_map_components cf_map_components
by (cs_concl cs_simp: cat_cs_simps)
qed
(
auto simp:
cat_cs_simps
cf_of_cf_map_components
cf_map_components
cf_ObjMap_vrange
intro: cat_cs_intros
)
lemma (in is_functor) cf_of_cf_map_is_functor':
assumes "π' = cf_map π"
and "π' = π"
and "π
' = π
"
shows "cf_of_cf_map π π
π' : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule cf_of_cf_map_is_functor)
lemmas [cat_map_cs_intros] = is_functor.cf_of_cf_map_is_functor'
subsubsectionβΉThe value of the conversion of a functor map to a functorβΊ
lemma (in is_functor) cf_of_cf_map_of_cf_map[cat_map_cs_simps]:
"cf_of_cf_map π π
(cf_map π) = π"
proof(rule cf_eqI)
show "cf_of_cf_map π π
(cf_map π) : π β¦β¦β©CβΞ±β π
"
proof(rule is_functorI')
show "vfsequence (cf_of_cf_map π π
(cf_map π))"
unfolding cf_of_cf_map_def by auto
show "vcard (cf_of_cf_map π π
(cf_map π)) = 4β©β"
unfolding cf_of_cf_map_def by (simp add: nat_omega_simps)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦fβ¦ :
cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦aβ¦ β¦βπ
β
cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βπβ b" for a b f
unfolding cf_of_cf_map_components cf_map_components
using is_functor_axioms that
by (cs_concl cs_intro: cat_cs_intros)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦g ββ©Aβπβ fβ¦ =
cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦gβ¦ ββ©Aβπ
β
cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βπβ c" and "f : a β¦βπβ b" for b c g a f
unfolding cf_of_cf_map_components cf_map_components
using is_functor_axioms that
by (cs_concl cs_simp: cat_cs_simps)
show
"cf_of_cf_map π π
(cf_map π)β¦ArrMapβ¦β¦πβ¦CIdβ¦β¦cβ¦β¦ =
π
β¦CIdβ¦β¦cf_of_cf_map π π
(cf_map π)β¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β πβ¦Objβ¦" for c
unfolding cf_of_cf_map_components cf_map_components
using is_functor_axioms that
by (cs_concl cs_simp: cat_cs_simps)
qed
(
auto simp:
cat_cs_simps
cf_of_cf_map_components
cf_map_components
cf_ObjMap_vrange
intro: cat_cs_intros
)
qed (auto simp: cf_of_cf_map_components cf_map_components intro: cat_cs_intros)
lemmas [cat_map_cs_simps] = is_functor.cf_of_cf_map_of_cf_map
subsectionβΉNatural transformation arrowβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_arrow :: "V β V"
where "ntcf_arrow π = [πβ¦NTMapβ¦, cf_map (πβ¦NTDomβ¦), cf_map (πβ¦NTCodβ¦)]β©β"
abbreviation ntcf_arrows :: "V β V β V β V"
where "ntcf_arrows Ξ± π π
β‘
set {ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
abbreviation tm_ntcf_arrows :: "V β V β V β V"
where "tm_ntcf_arrows Ξ± π π
β‘
set {ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
lemma tm_ntcf_arrows_subset_ntcf_arrows:
"{ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
} β
{ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
by auto
textβΉComponents.βΊ
lemma ntcf_arrow_components:
shows [cat_map_cs_simps]: "ntcf_arrow πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "ntcf_arrow πβ¦NTDomβ¦ = cf_map (πβ¦NTDomβ¦)"
and "ntcf_arrow πβ¦NTCodβ¦ = cf_map (πβ¦NTCodβ¦)"
unfolding ntcf_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma (in is_ntcf) ntcf_arrow_components':
shows "ntcf_arrow πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "ntcf_arrow πβ¦NTDomβ¦ = cf_map π"
and "ntcf_arrow πβ¦NTCodβ¦ = cf_map π"
unfolding ntcf_arrow_components ntcf_NTDom ntcf_NTCod by simp_all
lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_components'(2,3)
textβΉElementary properties.βΊ
lemma dg_FUNCT_Arr_components:
shows "[NTM, NTD, NTC]β©ββ¦NTMapβ¦ = NTM"
and "[NTM, NTD, NTC]β©ββ¦NTDomβ¦ = NTD"
and "[NTM, NTD, NTC]β©ββ¦NTCodβ¦ = NTC"
unfolding nt_field_simps by (simp_all add: nat_omega_simps)
lemma ntcf_arrow_vfsequence[cat_map_cs_intros]: "vfsequence (ntcf_arrow π)"
unfolding ntcf_arrow_def by simp
lemma ntcf_arrow_vdomain[cat_map_cs_simps]: "πβ©β (ntcf_arrow π) = 3β©β"
unfolding ntcf_arrow_def by (simp add: nat_omega_simps)
textβΉSize.βΊ
lemma (in is_ntcf) ntcf_arrow_NTMap_in_Vset:
assumes "Ξ± ββ©β Ξ²"
shows "ntcf_arrow πβ¦NTMapβ¦ ββ©β Vset Ξ²"
using assms unfolding ntcf_arrow_components by (intro ntcf_NTMap_in_Vset)
lemma (in is_tm_ntcf) tm_ntcf_arrow_NTMap_in_Vset:
"ntcf_arrow πβ¦NTMapβ¦ ββ©β Vset Ξ±"
unfolding ntcf_arrow_components by (rule tm_ntcf_NTMap_in_Vset)
lemma (in is_ntcf) ntcf_arrow_NTDom_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ntcf_arrow πβ¦NTDomβ¦ ββ©β Vset Ξ²"
using assms unfolding ntcf_arrow_components' by (rule NTDom.cf_map_in_Vset)
lemma (in is_tm_ntcf) tm_ntcf_arrow_NTDom_in_Vset:
"ntcf_arrow πβ¦NTDomβ¦ ββ©β Vset Ξ±"
unfolding ntcf_arrow_components' by (rule NTDom.tm_cf_map_in_Vset)
lemma (in is_ntcf) ntcf_arrow_NTCod_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ntcf_arrow πβ¦NTCodβ¦ ββ©β Vset Ξ²"
using assms unfolding ntcf_arrow_components' by (rule NTCod.cf_map_in_Vset)
lemma (in is_tm_ntcf) tm_ntcf_arrow_NTCod_in_Vset:
"ntcf_arrow πβ¦NTCodβ¦ ββ©β Vset Ξ±"
unfolding ntcf_arrow_components' by (rule NTCod.tm_cf_map_in_Vset)
lemma (in is_ntcf) ntcf_arrow_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ntcf_arrow π ββ©β Vset Ξ²"
proof-
interpret ntcf_arrow: vfsequence βΉntcf_arrow πβΊ
by (auto intro: cat_map_cs_intros)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show ?thesis
proof(rule vsv.vsv_Limit_vsv_in_VsetI)
from assms show "πβ©β (ntcf_arrow π) ββ©β Vset Ξ²"
by (auto simp: cat_map_cs_simps)
have "n ββ©β πβ©β (ntcf_arrow π) βΉ ntcf_arrow πβ¦nβ¦ ββ©β Vset Ξ²" for n
by
(
unfold ntcf_arrow_vdomain,
elim_in_numeral,
allβΉrewrite in "β ββ©β _" nt_field_simps[symmetric]βΊ,
insert assms,
unfold ntcf_arrow_components'
)
(
auto intro:
ntcf_NTMap_in_Vset NTDom.cf_map_in_Vset NTCod.cf_map_in_Vset
)
with ntcf_arrow.vsv_vrange_vsubset show "ββ©β (ntcf_arrow π) ββ©β Vset Ξ²"
by simp
qed (auto simp: cat_map_cs_simps)
qed
lemma (in is_tm_ntcf) tm_ntcf_arrow_in_Vset: "ntcf_arrow π ββ©β Vset Ξ±"
proof-
interpret tm_ntcf_arrow: vfsequence βΉntcf_arrow πβΊ
by (auto intro: cat_map_cs_intros)
show ?thesis
proof(rule vsv.vsv_Limit_vsv_in_VsetI)
have "n ββ©β πβ©β (ntcf_arrow π) βΉ ntcf_arrow πβ¦nβ¦ ββ©β Vset Ξ±" for n
by
(
unfold ntcf_arrow_vdomain,
elim_in_numeral,
allβΉrewrite in "β ββ©β _" nt_field_simps[symmetric]βΊ
)
(
intro tm_ntcf_arrow_NTMap_in_Vset
tm_ntcf_arrow_NTDom_in_Vset
tm_ntcf_arrow_NTCod_in_Vset
)+
with tm_ntcf_arrow.vsv_vrange_vsubset show "ββ©β (ntcf_arrow π) ββ©β Vset Ξ±"
by auto
qed (auto simp: cat_map_cs_simps)
qed
lemma ntcf_arrows_subset_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows
"{ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
} β elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
fix x π π π assume x_def: "x = ntcf_arrow π"
and π: "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
interpret is_ntcf Ξ± π π
π π π by (rule π)
show "x ββ©β Vset Ξ²" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
qed
lemma tm_ntcf_arrows_subset_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows
"{ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
} β
elts (Vset Ξ²)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
fix x π π π assume x_def: "x = ntcf_arrow π"
and π: "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
interpret is_tm_ntcf Ξ± π π
π π π by (rule π)
show "x ββ©β Vset Ξ²" unfolding x_def by (rule ntcf_arrow_in_Vset[OF assms])
qed
lemma small_ntcf_arrows[simp]:
"small {ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
}"
proof(cases βΉπ΅ Ξ±βΊ)
case True
from is_ntcf.ntcf_arrow_in_Vset show ?thesis
by (intro down[of _ βΉVset (Ξ± + Ο)βΊ])
(auto simp: True π΅.π΅_Limit_Ξ±Ο π΅.π΅_Ο_Ξ±Ο π΅.intro π΅.π΅_Ξ±_Ξ±Ο)
next
case False
then have "{ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
} = {}"
by auto
then show ?thesis by simp
qed
lemma small_tm_ntcf_arrows[simp]:
"small {ntcf_arrow π | π. βπ π. π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
}"
by
(
rule smaller_than_small[
OF small_ntcf_arrows tm_ntcf_arrows_subset_ntcf_arrows
]
)
lemma (in is_ntcf) ntcf_arrow_in_Vset_7: "ntcf_arrow π ββ©β Vset (Ξ± + 7β©β)"
proof-
note [folded VPow_iff, folded Vset_succ[OF Ord_Ξ±], cat_cs_intros] =
ntcf_NTMap_vsubset_Vset
from NTDom.cf_map_in_Vset_4 have [cat_cs_intros]:
"cf_map π ββ©β Vset (succ (succ (succ (succ Ξ±))))"
by succ_of_numeral (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
from NTCod.cf_map_in_Vset_4 have [cat_cs_intros]:
"cf_map π ββ©β Vset (succ (succ (succ (succ Ξ±))))"
by succ_of_numeral (cs_prems cs_simp: plus_V_succ_right V_cs_simps)
show ?thesis
by (subst ntcf_arrow_def, succ_of_numeral, unfold cat_cs_simps)
(
cs_concl
cs_simp: plus_V_succ_right V_cs_simps
cs_intro: V_cs_intros cat_cs_intros
)
qed
lemma (in π΅) ntcf_arrows_in_Vset:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ntcf_arrows Ξ± π π
ββ©β Vset Ξ²"
proof(rule vsubset_in_VsetI)
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "ntcf_arrows Ξ± π π
ββ©β Vset (Ξ± + 7β©β)"
proof(intro vsubsetI)
fix π assume "π ββ©β ntcf_arrows Ξ± π π
"
then obtain π' π π
where π_def: "π = ntcf_arrow π'"
and π': "π' : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by clarsimp
interpret is_ntcf Ξ± π π
π π π' using π' by simp
show "π ββ©β Vset (Ξ± + 7β©β)" unfolding π_def by (rule ntcf_arrow_in_Vset_7)
qed
from assms(2) show "Vset (Ξ± + 7β©β) ββ©β Vset Ξ²"
by (cs_concl cs_intro: V_cs_intros Ord_cs_intros)
qed
lemma (in π΅) tm_ntcf_arrows_vsubset_Vset: "tm_ntcf_arrows Ξ± π π
ββ©β Vset Ξ±"
by (clarsimp simp: is_tm_ntcf.tm_ntcf_arrow_in_Vset)
textβΉRules.βΊ
lemma (in is_ntcf) ntcf_arrowsI: "ntcf_arrow π ββ©β ntcf_arrows Ξ± π π
"
using is_ntcf_axioms by auto
lemma (in is_tm_ntcf) tm_ntcf_arrowsI: "ntcf_arrow π ββ©β tm_ntcf_arrows Ξ± π π
"
using is_ntcf_axioms by (auto intro: cat_small_cs_intros)
lemma (in is_ntcf) ntcf_arrowsI':
assumes "π' = ntcf_arrow π"
shows "π' ββ©β ntcf_arrows Ξ± π π
"
unfolding assms(1) by (rule ntcf_arrowsI)
lemma (in is_tm_ntcf) tm_ntcf_arrowsI':
assumes "π' = ntcf_arrow π"
shows "π' ββ©β tm_ntcf_arrows Ξ± π π
"
unfolding assms(1) by (rule tm_ntcf_arrowsI)
lemmas [cat_map_cs_intros] =
is_ntcf.ntcf_arrowsI
lemmas ntcf_arrowsI'[cat_map_cs_intros] =
is_ntcf.ntcf_arrowsI'[rotated]
lemmas [cat_map_cs_intros] =
is_tm_ntcf.tm_ntcf_arrowsI
lemmas tm_ntcf_arrowsI'[cat_map_cs_intros] =
is_tm_ntcf.tm_ntcf_arrowsI'[rotated]
lemma ntcf_arrowsE[elim]:
assumes "π ββ©β ntcf_arrows Ξ± π π
"
obtains π π π where "π = ntcf_arrow π" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
using assms by auto
lemma tm_ntcf_arrowsE[elim]:
assumes "π ββ©β tm_ntcf_arrows Ξ± π π
"
obtains π π π where "π = ntcf_arrow π"
and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
using assms by auto
textβΉElementary properties.βΊ
lemma tm_ntcf_arrows_vsubset_ntcf_arrows:
"tm_ntcf_arrows Ξ± π π
ββ©β ntcf_arrows Ξ± π π
"
using tm_ntcf_arrows_subset_ntcf_arrows by auto
lemma tm_ntcf_arrows_in_cf_arrows[cat_map_cs_intros]:
assumes "π ββ©β tm_ntcf_arrows Ξ± π π
"
shows "π ββ©β ntcf_arrows Ξ± π π
"
using assms tm_ntcf_arrows_vsubset_ntcf_arrows[of Ξ± π π
] by blast
lemma ntcf_arrow_inj:
assumes "ntcf_arrow π = ntcf_arrow π"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
shows "π = π"
proof(rule ntcf_eqI)
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(2))
interpret π: is_ntcf Ξ± π π
π' π' π by (rule assms(3))
from assms(1) have NTMap: "ntcf_arrow πβ¦NTMapβ¦ = ntcf_arrow πβ¦NTMapβ¦"
and NTDom: "ntcf_arrow πβ¦NTDomβ¦ = ntcf_arrow πβ¦NTDomβ¦"
and NTCod: "ntcf_arrow πβ¦NTCodβ¦ = ntcf_arrow πβ¦NTCodβ¦"
by auto
from NTMap show "πβ¦NTMapβ¦ = πβ¦NTMapβ¦" unfolding ntcf_arrow_components by simp
from NTDom NTCod show "πβ¦NTDomβ¦ = πβ¦NTDomβ¦" "πβ¦NTCodβ¦ = πβ¦NTCodβ¦"
unfolding ntcf_arrow_components cf_map_components
by
(
auto simp:
cat_cs_simps
cf_map_eq_iff[OF π.NTDom.is_functor_axioms π.NTDom.is_functor_axioms]
cf_map_eq_iff[OF π.NTCod.is_functor_axioms π.NTCod.is_functor_axioms]
)
from assms(2,3) show
"π : πβ¦NTDomβ¦ β¦β©Cβ©F πβ¦NTCodβ¦ : π β¦β¦β©CβΞ±β π
"
"π : πβ¦NTDomβ¦ β¦β©Cβ©F πβ¦NTCodβ¦ : π β¦β¦β©CβΞ±β π
"
by (auto simp: cat_cs_simps)
qed auto
lemma ntcf_arrow_eq_iff[cat_map_cs_simps]:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" and "π : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
shows "ntcf_arrow π = ntcf_arrow π β· π = π"
using ntcf_arrow_inj[OF _ assms] by auto
lemma ntcf_arrow_eqI:
assumes "π ββ©β ntcf_arrows Ξ± π π
"
and "π ββ©β ntcf_arrows Ξ± π π
"
and "πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "πβ¦NTDomβ¦ = πβ¦NTDomβ¦"
and "πβ¦NTCodβ¦ = πβ¦NTCodβ¦"
shows "π = π"
proof-
from assms(1) obtain π' π π
where π_def: "π = ntcf_arrow π'" and π': "π' : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
from assms(2) obtain π' π' π'
where π_def: "π = ntcf_arrow π'" and π': "π' : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
by auto
show ?thesis
proof(rule vsv_eqI, unfold π_def π_def)
show "a ββ©β πβ©β (ntcf_arrow π') βΉ ntcf_arrow π'β¦aβ¦ = ntcf_arrow π'β¦aβ¦"
for a
by
(
unfold ntcf_arrow_vdomain,
elim_in_numeral,
insert assms(3-5),
unfold π_def π_def,
fold nt_field_simps
)
simp_all
qed (auto intro: cat_map_cs_intros simp: cat_map_cs_simps)
qed
subsectionβΉ
Conversion of a natural transformation arrow to a natural transformation
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_of_ntcf_arrow :: "V β V β V β V"
where "ntcf_of_ntcf_arrow π π
π =
[
πβ¦NTMapβ¦,
cf_of_cf_map π π
(πβ¦NTDomβ¦),
cf_of_cf_map π π
(πβ¦NTCodβ¦),
π,
π
]β©β"
textβΉComponents.βΊ
lemma ntcf_of_ntcf_arrow_components[cat_map_cs_simps]:
shows "ntcf_of_ntcf_arrow π π
πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "ntcf_of_ntcf_arrow π π
πβ¦NTDomβ¦ = cf_of_cf_map π π
(πβ¦NTDomβ¦)"
and "ntcf_of_ntcf_arrow π π
πβ¦NTCodβ¦ = cf_of_cf_map π π
(πβ¦NTCodβ¦)"
and "ntcf_of_ntcf_arrow π π
πβ¦NTDGDomβ¦ = π"
and "ntcf_of_ntcf_arrow π π
πβ¦NTDGCodβ¦ = π
"
unfolding ntcf_of_ntcf_arrow_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉ
The conversion of a natural transformation arrow
to a natural transformation is a natural transformation
βΊ
lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf:
"ntcf_of_ntcf_arrow π π
(ntcf_arrow π) : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
proof(rule is_ntcfI')
show "vfsequence (ntcf_of_ntcf_arrow π π
(ntcf_arrow π))"
unfolding ntcf_of_ntcf_arrow_def by auto
show "vcard (ntcf_of_ntcf_arrow π π
(ntcf_arrow π)) = 5β©β"
unfolding ntcf_of_ntcf_arrow_def by (simp add: nat_omega_simps)
show "ntcf_of_ntcf_arrow π π
(ntcf_arrow π)β¦NTMapβ¦β¦aβ¦ :
πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β πβ¦Objβ¦" for a
using is_ntcf_axioms that
by (cs_concl cs_simp: cat_map_cs_simps cs_intro: cat_cs_intros)
show "ntcf_of_ntcf_arrow π π
(ntcf_arrow π)β¦NTMapβ¦β¦bβ¦ ββ©Aβπ
β πβ¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβπ
β ntcf_of_ntcf_arrow π π
(ntcf_arrow π)β¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπβ b" for a b f
using is_ntcf_axioms that
by
(
cs_concl
cs_simp: ntcf_Comp_commute cat_map_cs_simps cs_intro: cat_cs_intros
)
qed (use is_ntcf_axioms in βΉauto simp: cat_cs_simps cat_map_cs_simpsβΊ)
lemma (in is_ntcf) ntcf_of_ntcf_arrow_is_ntcf':
assumes "π' = ntcf_arrow π" and "π' = π" and "π
' = π
"
shows "ntcf_of_ntcf_arrow π π
π' : π β¦β©Cβ©F π : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule ntcf_of_ntcf_arrow_is_ntcf)
lemmas [cat_map_cs_intros] = is_ntcf.ntcf_of_ntcf_arrow_is_ntcf'
subsubsectionβΉ
The composition of the conversion of a natural transformation arrow
to a natural transformation
βΊ
lemma (in is_ntcf) ntcf_of_ntcf_arrow[cat_map_cs_simps]:
"ntcf_of_ntcf_arrow π π
(ntcf_arrow π) = π"
by (rule ntcf_eqI)
(auto simp: cat_map_cs_simps intro: cat_cs_intros ntcf_of_ntcf_arrow_is_ntcf)
lemmas [cat_map_cs_simps] = is_ntcf.ntcf_of_ntcf_arrow
subsectionβΉComposition of the natural transformation arrowsβΊ
definition ntcf_arrow_vcomp :: "V β V β V β V β V"
where "ntcf_arrow_vcomp π π
π π =
ntcf_arrow (ntcf_of_ntcf_arrow π π
π ββ©Nβ©Tβ©Cβ©F ntcf_of_ntcf_arrow π π
π)"
syntax "_ntcf_arrow_vcomp" :: "V β V β V β V β V"
(βΉ(_/ ββ©Nβ©Tβ©Cβ©Fβ_,_β _)βΊ [55, 56, 57, 58] 55)
translations "π ββ©Nβ©Tβ©Cβ©Fβπ,π
β π" β "CONST ntcf_arrow_vcomp π π
π π"
textβΉComponents.βΊ
lemma (in is_ntcf) ntcf_arrow_vcomp_components:
"(ntcf_arrow π ββ©Nβ©Tβ©Cβ©Fβπ,π
β ntcf_arrow π)β¦NTMapβ¦ = (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦"
"(ntcf_arrow π ββ©Nβ©Tβ©Cβ©Fβπ,π
β ntcf_arrow π)β¦NTDomβ¦ = cf_map ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTDomβ¦)"
"(ntcf_arrow π ββ©Nβ©Tβ©Cβ©Fβπ,π
β ntcf_arrow π)β¦NTCodβ¦ = cf_map ((π ββ©Nβ©Tβ©Cβ©F π)β¦NTCodβ¦)"
unfolding
ntcf_arrow_vcomp_def
ntsmcf_vcomp_components
ntcf_arrow_components
ntcf_of_ntcf_arrow_components
by (simp_all add: cat_cs_simps cat_map_cs_simps)
lemmas [cat_map_cs_simps] = is_ntcf.ntcf_arrow_vcomp_components
textβΉElementary properties.βΊ
lemma ntcf_arrow_vcomp_ntcf_vcomp[cat_map_cs_simps]:
assumes "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β π
" and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_arrow π ββ©Nβ©Tβ©Cβ©Fβπ,π
β ntcf_arrow π = ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)"
by (rule ntcf_arrow_eqI, insert assms)
(
cs_concl
cs_simp: ntcf_arrow_vcomp_def cat_map_cs_simps cat_cs_simps
cs_intro: cat_map_cs_intros cat_cs_intros
)+
subsectionβΉIdentity natural transformation arrowβΊ
definition ntcf_arrow_id :: "V β V β V β V"
where "ntcf_arrow_id π π
π = ntcf_arrow (ntcf_id (cf_of_cf_map π π
π))"
textβΉComponents.βΊ
lemma (in is_functor) ntcf_arrow_id_components:
"(ntcf_arrow_id π π
(cf_map π))β¦NTMapβ¦ = ntcf_id πβ¦NTMapβ¦"
"(ntcf_arrow_id π π
(cf_map π))β¦NTDomβ¦ = cf_map (ntcf_id πβ¦NTDomβ¦)"
"(ntcf_arrow_id π π
(cf_map π))β¦NTCodβ¦ = cf_map (ntcf_id πβ¦NTCodβ¦)"
unfolding ntcf_arrow_id_def ntcf_arrow_components
by (simp_all add: cat_map_cs_simps)
lemmas [cat_map_cs_simps] = is_functor.ntcf_arrow_id_components
textβΉIdentity natural transformation arrow is a natural transformation arrow.βΊ
lemma ntcf_arrow_id_ntcf_id[cat_map_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_arrow_id π π
(cf_map π) = ntcf_arrow (ntcf_id π)"
by (rule ntcf_arrow_eqI, insert assms, unfold ntcf_arrow_id_def)
(
cs_concl
cs_simp: cat_map_cs_simps cat_cs_simps
cs_intro: cat_map_cs_intros cat_cs_intros
)
subsectionβΉβΉFUNCTβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition dg_FUNCT :: "V β V β V β V"
where "dg_FUNCT Ξ± π π
=
[
cf_maps Ξ± π π
,
ntcf_arrows Ξ± π π
,
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)
]β©β"
lemmas [dg_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [dg_FUNCT_cs_intros] = cat_map_cs_intros
textβΉComponents.βΊ
lemma dg_FUNCT_components:
shows "dg_FUNCT Ξ± π π
β¦Objβ¦ = cf_maps Ξ± π π
"
and "dg_FUNCT Ξ± π π
β¦Arrβ¦ = ntcf_arrows Ξ± π π
"
and "dg_FUNCT Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "dg_FUNCT Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
unfolding dg_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObjectsβΊ
lemma (in is_functor) dg_FUNCT_ObjI: "cf_map π ββ©β dg_FUNCT Ξ± π π
β¦Objβ¦"
unfolding dg_FUNCT_components by (auto intro: cat_cs_intros)
subsubsectionβΉDomain and codomainβΊ
mk_VLambda dg_FUNCT_components(3)
|vsv dg_FUNCT_Dom_vsv[dg_FUNCT_cs_intros]|
|vdomain dg_FUNCT_Dom_vdomain[dg_FUNCT_cs_simps]|
mk_VLambda dg_FUNCT_components(4)
|vsv dg_FUNCT_Cod_vsv[dg_FUNCT_cs_intros]|
|vdomain dg_FUNCT_Cod_vdomain[dg_FUNCT_cs_simps]|
lemma (in is_ntcf)
shows dg_FUNCT_Dom_app: "dg_FUNCT Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
and dg_FUNCT_Cod_app: "dg_FUNCT Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
proof-
from is_ntcf_axioms show
"dg_FUNCT Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
"dg_FUNCT Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
unfolding dg_FUNCT_components
by (cs_concl cs_simp: dg_FUNCT_cs_simps V_cs_simps cs_intro: dg_FUNCT_cs_intros)+
qed
lemma (in is_ntcf)
assumes "π' = ntcf_arrow π"
shows dg_FUNCT_Dom_app': "dg_FUNCT Ξ± π π
β¦Domβ¦β¦π'β¦ = cf_map π"
and dg_FUNCT_Cod_app': "dg_FUNCT Ξ± π π
β¦Codβ¦β¦π'β¦ = cf_map π"
unfolding assms by (intro dg_FUNCT_Dom_app dg_FUNCT_Cod_app)+
lemmas [dg_FUNCT_cs_simps] =
is_ntcf.dg_FUNCT_Dom_app'
is_ntcf.dg_FUNCT_Cod_app'
lemma
shows dg_FUNCT_Dom_vrange: "ββ©β (dg_FUNCT Ξ± π π
β¦Domβ¦) ββ©β dg_FUNCT Ξ± π π
β¦Objβ¦"
and dg_FUNCT_Cod_vrange: "ββ©β (dg_FUNCT Ξ± π π
β¦Codβ¦) ββ©β dg_FUNCT Ξ± π π
β¦Objβ¦"
unfolding dg_FUNCT_components
proof(allβΉintro vrange_VLambda_vsubsetβΊ)
fix π assume "π ββ©β ntcf_arrows Ξ± π π
"
then obtain π π π where π_def[dg_FUNCT_cs_simps]: "π = ntcf_arrow π"
and π: "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
from π show "πβ¦NTDomβ¦ ββ©β cf_maps Ξ± π π
"
by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros)
from π show "πβ¦NTCodβ¦ ββ©β cf_maps Ξ± π π
"
by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: dg_FUNCT_cs_intros cat_cs_intros)
qed
subsubsectionβΉβΉFUNCTβΊ is a tiny digraphβΊ
lemma (in π΅) tiny_digraph_dg_FUNCT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_digraph Ξ² (dg_FUNCT Ξ± π π
)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show ?thesis
proof(intro tiny_digraphI)
show "vfsequence (dg_FUNCT Ξ± π π
)" unfolding dg_FUNCT_def by simp
show "vcard (dg_FUNCT Ξ± π π
) = 4β©β"
unfolding dg_FUNCT_def by (simp add: nat_omega_simps)
show "ββ©β (dg_FUNCT Ξ± π π
β¦Domβ¦) ββ©β dg_FUNCT Ξ± π π
β¦Objβ¦"
by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
show "ββ©β (dg_FUNCT Ξ± π π
β¦Codβ¦) ββ©β dg_FUNCT Ξ± π π
β¦Objβ¦"
by (simp add: dg_FUNCT_Dom_vrange dg_FUNCT_Cod_vrange)
from assms show "dg_FUNCT Ξ± π π
β¦Objβ¦ ββ©β Vset Ξ²"
unfolding dg_FUNCT_components(1) by (rule cf_maps_in_Vset)
show "dg_FUNCT Ξ± π π
β¦Arrβ¦ ββ©β Vset Ξ²"
unfolding dg_FUNCT_components(2) by (rule ntcf_arrows_in_Vset[OF assms])
qed (auto simp: dg_FUNCT_cs_simps dg_FUNCT_components(1,2) intro: dg_FUNCT_cs_intros)
qed
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma dg_FUNCT_is_arrI:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_arrow π : cf_map π β¦βdg_FUNCT Ξ± π π
β cf_map π"
proof(intro is_arrI, unfold dg_FUNCT_components(1,2))
interpret is_ntcf Ξ± π π
π π π by (rule assms)
from assms show "ntcf_arrow π ββ©β ntcf_arrows Ξ± π π
" by auto
from assms show
"dg_FUNCT Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
"dg_FUNCT Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
by (cs_concl cs_simp: dg_FUNCT_cs_simps)+
qed
lemma dg_FUNCT_is_arrI':
assumes "π' = ntcf_arrow π"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "π' = cf_map π"
and "π' = cf_map π"
shows "π' : π' β¦βdg_FUNCT Ξ± π π
β π'"
using assms(2) unfolding assms(1,3,4) by (rule dg_FUNCT_is_arrI)
lemmas [dg_FUNCT_cs_intros] = dg_FUNCT_is_arrI'
lemma dg_FUNCT_is_arrD[dest]:
assumes "π : π β¦βdg_FUNCT Ξ± π π
β π"
shows "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©F cf_of_cf_map π π
π : π β¦β¦β©CβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
proof-
note π = is_arrD[OF assms, unfolded dg_FUNCT_components(2)]
obtain π' π' π' where π_def: "π = ntcf_arrow π'"
and π': "π' : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
by (elim ntcf_arrowsE[OF π(1)])
from π(2) π' have π_def: "π = cf_map π'"
by (cs_prems cs_simp: π_def dg_FUNCT_cs_simps) simp
from π(3) π' have π_def: "π = cf_map π'"
by (cs_prems cs_simp: π_def dg_FUNCT_cs_simps) simp
from π' have π'_def: "π' = ntcf_of_ntcf_arrow π π
π"
unfolding π_def by (cs_concl cs_simp: dg_FUNCT_cs_simps)
from π' have π'_def: "π' = cf_of_cf_map π π
π"
and π'_def: "π' = cf_of_cf_map π π
π"
unfolding π_def π_def
by (cs_concl cs_simp: dg_FUNCT_cs_simps cs_intro: cat_cs_intros)+
from π' show "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©F cf_of_cf_map π π
π : π β¦β¦β©CβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
by (fold π'_def π'_def π'_def π_def π_def π_def) simp_all
qed
lemma dg_FUNCT_is_arrE[elim]:
assumes "π : π β¦βdg_FUNCT Ξ± π π
β π"
obtains π' π' π'
where "π' : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
and "π = ntcf_arrow π'"
and "π = cf_map π'"
and "π = cf_map π'"
using dg_FUNCT_is_arrD[OF assms] by auto
subsectionβΉβΉFunctβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition dg_Funct :: "V β V β V β V"
where "dg_Funct Ξ± π π
=
[
tm_cf_maps Ξ± π π
,
tm_ntcf_arrows Ξ± π π
,
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma dg_Funct_components:
shows "dg_Funct Ξ± π π
β¦Objβ¦ = tm_cf_maps Ξ± π π
"
and "dg_Funct Ξ± π π
β¦Arrβ¦ = tm_ntcf_arrows Ξ± π π
"
and "dg_Funct Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "dg_Funct Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
unfolding dg_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObjectsβΊ
lemma (in is_tm_functor) dg_Funct_ObjI: "cf_map π ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
unfolding dg_Funct_components by (auto simp: cat_small_cs_intros)
subsubsectionβΉDomain and codomainβΊ
mk_VLambda dg_Funct_components(3)
|vsv dg_Funct_Dom_vsv[dg_FUNCT_cs_intros]|
|vdomain dg_Funct_Dom_vdomain[dg_FUNCT_cs_simps]|
mk_VLambda dg_Funct_components(4)
|vsv dg_Funct_Cod_vsv[dg_FUNCT_cs_intros]|
|vdomain dg_Funct_Cod_vdomain[dg_FUNCT_cs_simps]|
lemma (in is_tm_ntcf)
shows dg_Funct_Dom_app: "dg_Funct Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
and dg_Funct_Cod_app: "dg_Funct Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
proof-
from is_tm_ntcf_axioms show
"dg_Funct Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
"dg_Funct Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
unfolding dg_Funct_components
by
(
cs_concl
cs_simp: dg_FUNCT_cs_simps V_cs_simps
cs_intro: dg_FUNCT_cs_intros cat_cs_intros
)+
qed
lemma (in is_tm_ntcf)
assumes "π' = ntcf_arrow π"
shows dg_Funct_Dom_app': "dg_Funct Ξ± π π
β¦Domβ¦β¦π'β¦ = cf_map π"
and dg_Funct_Cod_app': "dg_Funct Ξ± π π
β¦Codβ¦β¦π'β¦ = cf_map π"
unfolding assms by (intro dg_Funct_Dom_app dg_Funct_Cod_app)+
lemmas [dg_FUNCT_cs_simps] =
is_tm_ntcf.dg_Funct_Dom_app'
is_tm_ntcf.dg_Funct_Cod_app'
lemma
shows dg_Funct_Dom_vrange: "ββ©β (dg_Funct Ξ± π π
β¦Domβ¦) ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
and dg_Funct_Cod_vrange: "ββ©β (dg_Funct Ξ± π π
β¦Codβ¦) ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
unfolding dg_Funct_components
proof(allβΉintro vrange_VLambda_vsubsetβΊ)
fix π assume "π ββ©β tm_ntcf_arrows Ξ± π π
"
then obtain π π π where π_def[dg_FUNCT_cs_simps]: "π = ntcf_arrow π"
and π: "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by auto
from π show "πβ¦NTDomβ¦ ββ©β tm_cf_maps Ξ± π π
"
by
(
cs_concl
cs_simp: dg_FUNCT_cs_simps
cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
)
from π show "πβ¦NTCodβ¦ ββ©β tm_cf_maps Ξ± π π
"
by
(
cs_concl
cs_simp: dg_FUNCT_cs_simps
cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros
)
qed
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma dg_Funct_is_arrI:
assumes "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
shows "ntcf_arrow π : cf_map π β¦βdg_Funct Ξ± π π
β cf_map π"
proof(intro is_arrI, unfold dg_Funct_components(1,2))
interpret is_tm_ntcf Ξ± π π
π π π by (rule assms)
from assms show "ntcf_arrow π ββ©β tm_ntcf_arrows Ξ± π π
" by auto
from assms show
"dg_Funct Ξ± π π
β¦Domβ¦β¦ntcf_arrow πβ¦ = cf_map π"
"dg_Funct Ξ± π π
β¦Codβ¦β¦ntcf_arrow πβ¦ = cf_map π"
by (cs_concl cs_simp: dg_FUNCT_cs_simps)+
qed
lemma dg_Funct_is_arrI':
assumes "π' = ntcf_arrow π"
and "π : π β¦β©Cβ©Fβ©.β©tβ©m π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π' = cf_map π"
and "π' = cf_map π"
shows "π' : π' β¦βdg_Funct Ξ± π π
β π'"
using assms(2) unfolding assms(1,3,4) by (rule dg_Funct_is_arrI)
lemmas [dg_FUNCT_cs_intros] = dg_Funct_is_arrI'
lemma dg_Funct_is_arrD[dest]:
assumes "π : π β¦βdg_Funct Ξ± π π
β π"
shows "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©tβ©m cf_of_cf_map π π
π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
proof-
note π = is_arrD[OF assms, unfolded dg_Funct_components(2)]
obtain π' π' π' where π_def: "π = ntcf_arrow π'"
and π': "π' : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by (elim tm_ntcf_arrowsE[OF π(1)])
from π(2) π' have π_def: "π = cf_map π'"
by (cs_prems cs_simp: π_def dg_FUNCT_cs_simps) simp
from π(3) π' have π_def: "π = cf_map π'"
by (cs_prems cs_simp: π_def dg_FUNCT_cs_simps) simp
from π' have π'_def: "π' = ntcf_of_ntcf_arrow π π
π"
unfolding π_def
by
(
cs_concl
cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
)
from π' have π'_def: "π' = cf_of_cf_map π π
π"
and π'_def: "π' = cf_of_cf_map π π
π"
unfolding π_def π_def
by
(
cs_concl
cs_simp: dg_FUNCT_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
)+
from π' show "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©tβ©m cf_of_cf_map π π
π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
by (fold π'_def π'_def π'_def π_def π_def π_def) simp_all
qed
lemma dg_Funct_is_arrE[elim]:
assumes "π : π β¦βdg_Funct Ξ± π π
β π"
obtains π' π' π' where "π' : π' β¦β©Cβ©Fβ©.β©tβ©m π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π = ntcf_arrow π'"
and "π = cf_map π'"
and "π = cf_map π'"
using dg_Funct_is_arrD[OF assms] by auto
subsubsectionβΉβΉFunctβΊ is a digraphβΊ
lemma (in π΅) digraph_dg_Funct:
assumes "tiny_category Ξ± π" and "category Ξ± π
"
shows "digraph Ξ± (dg_Funct Ξ± π π
)"
proof(intro digraphI)
interpret tiny_category Ξ± π by (rule assms(1))
interpret π
: category Ξ± π
by (rule assms(2))
show "vfsequence (dg_Funct Ξ± π π
)" unfolding dg_Funct_def by simp
show "vcard (dg_Funct Ξ± π π
) = 4β©β"
unfolding dg_Funct_def by (simp add: nat_omega_simps)
show "ββ©β (dg_Funct Ξ± π π
β¦Domβ¦) ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
show "ββ©β (dg_Funct Ξ± π π
β¦Codβ¦) ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
by (simp add: dg_Funct_Dom_vrange dg_Funct_Cod_vrange)
show "dg_Funct Ξ± π π
β¦Objβ¦ ββ©β Vset Ξ±"
unfolding dg_Funct_components(1,2) by (rule tm_cf_maps_vsubset_Vset)
have RA:
"(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β Vset Ξ±"
"(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β π
β¦Objβ¦"
if "A ββ©β dg_Funct Ξ± π π
β¦Objβ¦" and "A ββ©β Vset Ξ±" for A
proof-
have "(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β π
β¦Objβ¦"
and "(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β ββ©β(ββ©β(ββ©β(ββ©β(ββ©β(ββ©βA)))))"
proof(allβΉintro vsubsetIβΊ)
fix f assume "f ββ©β (ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦))"
then obtain π where π: "π ββ©β A" and f: "f ββ©β ββ©β (πβ¦ObjMapβ¦)" by auto
with that(1) have "π ββ©β dg_Funct Ξ± π π
β¦Objβ¦" by (elim vsubsetE)
then obtain π'
where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
unfolding dg_Funct_components by auto
interpret π': is_tm_functor Ξ± π π
π' by (rule π')
from f obtain a where "a ββ©β πβ©β (π'β¦ObjMapβ¦)" and af: "β¨a, fβ© ββ©β π'β¦ObjMapβ¦"
unfolding π_def cf_map_components vdomain_iff by force
then show "f ββ©β π
β¦Objβ¦"
using π'.cf_ObjMap_vrange π_def cf_map_components(1) f vsubsetE by auto
show "f ββ©β ββ©β(ββ©β(ββ©β(ββ©β(ββ©β(ββ©βA)))))"
proof(intro VUnionI)
show "π ββ©β A" by (rule π)
show "set {0, πβ¦ObjMapβ¦} ββ©β β¨[]β©β, πβ¦ObjMapβ¦β©" unfolding vpair_def by simp
show "β¨a, fβ© ββ©β πβ¦ObjMapβ¦"
unfolding π_def cf_map_components by (intro af)
show "set {a, f} ββ©β β¨a, fβ©" unfolding vpair_def by clarsimp
qed (clarsimp simp: π_def cf_map_def dg_FUNCT_Obj_components)+
qed
moreover have "ββ©β(ββ©β(ββ©β(ββ©β(ββ©β(ββ©βA))))) ββ©β Vset Ξ±"
by (intro VUnion_in_VsetI that(2))
ultimately show
"(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β Vset Ξ±"
"(ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦)) ββ©β π
β¦Objβ¦"
by blast+
qed
fix A B assume prems:
"A ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
"B ββ©β dg_Funct Ξ± π π
β¦Objβ¦"
"A ββ©β Vset Ξ±"
"B ββ©β Vset Ξ±"
define ARs where "ARs = (ββ©βπββ©βA. ββ©β (πβ¦ObjMapβ¦))"
define BRs where "BRs = (ββ©βπββ©βB. ββ©β (πβ¦ObjMapβ¦))"
define Hom_AB where "Hom_AB = (ββ©βaββ©βARs. ββ©βbββ©βBRs. Hom π
a b)"
define Q where
"Q i = (if i = 0 then VPow (πβ¦Objβ¦ Γβ©β Hom_AB) else if i = 1β©β then A else B)"
for i
have
"{[π, π, π]β©β |π π π. π ββ©β πβ¦Objβ¦ Γβ©β Hom_AB β§ π ββ©β A β§ π ββ©β B} β
elts (ββ©βiββ©βset {0, 1β©β, 2β©β}. Q i)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
fix πππ π π π assume prems':
"πππ = [π, π, π]β©β" "π ββ©β πβ¦Objβ¦ Γβ©β Hom_AB" "π ββ©β A" "π ββ©β B"
show "πππ ββ©β (ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "πβ©β πππ = set {0, 1β©β, 2β©β}"
by (simp add: three prems'(1) nat_omega_simps)
fix i assume "i ββ©β set {0, 1β©β, 2β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ by auto
then show "πππβ¦iβ¦ ββ©β Q i"
by cases (auto simp: Q_def prems' nat_omega_simps)
qed (auto simp: prems'(1))
qed
moreover then have small[simp]:
"small {[r, a, b]β©β | r a b. r ββ©βπβ¦Objβ¦ Γβ©β Hom_AB β§ a ββ©β A β§ b ββ©β B}"
by (rule down)
ultimately have
"set {[r, a, b]β©β |r a b. r ββ©β πβ¦Objβ¦ Γβ©β Hom_AB β§ a ββ©β A β§ b ββ©β B} ββ©β
(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i)"
by auto
moreover have "(ββ©βiββ©β set {0, 1β©β, 2β©β}. Q i) ββ©β Vset Ξ±"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β} ββ©β Vset Ξ±"
by (cs_concl cs_intro: V_cs_intros cat_cs_intros cs_simp: V_cs_simps)
have "Hom_AB ββ©β Vset Ξ±"
unfolding Hom_AB_def
by
(
intro π
.cat_Hom_vifunion_in_Vset prems(3,4),
unfold ARs_def BRs_def;
intro RA prems
)
moreover have "πβ¦Objβ¦ ββ©β Vset Ξ±" by (intro tiny_cat_Obj_in_Vset)
ultimately have "VPow (πβ¦Objβ¦ Γβ©β Hom_AB) ββ©β Vset Ξ±"
by (cs_concl cs_intro: V_cs_intros)
with prems(3,4) show "Q i ββ©β Vset Ξ±" if "i ββ©β set {0, 1β©β, 2β©β}" for i
unfolding Q_def by (simp_all add: nat_omega_simps)
qed auto
moreover have
"(ββ©βaββ©βA. ββ©βbββ©βB. Hom (dg_Funct Ξ± π π
) a b) ββ©β
set {[r, a, b]β©β | r a b. r ββ©β πβ¦Objβ¦ Γβ©β Hom_AB β§ a ββ©β A β§ b ββ©β B}"
proof(rule vsubsetI)
fix π assume "π ββ©β (ββ©βaββ©βA. ββ©βbββ©βB. Hom (dg_Funct Ξ± π π
) a b)"
then obtain π π
where π: "π ββ©β A"
and π: "π ββ©β B"
and π_ab: "π ββ©β Hom (dg_Funct Ξ± π π
) π π"
by auto
then have "π : π β¦βdg_Funct Ξ± π π
β π" by simp
note π = dg_Funct_is_arrD[OF this]
show
"π ββ©β set {[r, a, b]β©β | r a b. r ββ©β πβ¦Objβ¦ Γβ©β Hom_AB β§ a ββ©β A β§ b ββ©β B}"
proof(intro in_set_CollectI small exI conjI)
show "π =
[
ntcf_of_ntcf_arrow π π
πβ¦NTMapβ¦,
cf_map (ntcf_of_ntcf_arrow π π
πβ¦NTDomβ¦),
cf_map (ntcf_of_ntcf_arrow π π
πβ¦NTCodβ¦)
]β©β"
by (rule π(2)[unfolded ntcf_arrow_def])
interpret π: is_tm_ntcf Ξ±
π π
βΉcf_of_cf_map π π
πβΊ βΉcf_of_cf_map π π
πβΊ
βΉntcf_of_ntcf_arrow π π
πβΊ
rewrites "ntcf_of_ntcf_arrow π π
πβ¦NTMapβ¦ = πβ¦NTMapβ¦"
and "cf_of_cf_map π π
πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
and "cf_of_cf_map π π
πβ¦ObjMapβ¦ = πβ¦ObjMapβ¦"
by
(
rule π(1),
unfold ntcf_of_ntcf_arrow_components cf_of_cf_map_components
)
simp_all
show "ntcf_of_ntcf_arrow π π
πβ¦NTMapβ¦ ββ©β πβ¦Objβ¦ Γβ©β Hom_AB"
proof(intro vsubsetI, unfold ntcf_of_ntcf_arrow_components)
fix af assume prems'': "af ββ©β πβ¦NTMapβ¦"
then obtain a f where af_def: "af = β¨a, fβ©"
and a: "a ββ©β πβ¦Objβ¦"
and f: "f ββ©β ββ©β (πβ¦NTMapβ¦)"
by (elim π.NTMap.vbrelation_vinE)
from prems'' have f_def: "f = πβ¦NTMapβ¦β¦aβ¦"
unfolding af_def π.NTMap.vsv_ex1_app1[OF a] .
have πa: "πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦"
by (rule π.ntcf_NTMap_is_arr[OF a])
have "f ββ©β Hom_AB"
unfolding f_def Hom_AB_def ARs_def BRs_def
proof(intro vifunionI, unfold in_Hom_iff)
show "π ββ©β A" by (intro π)
from a show "πβ¦ObjMapβ¦β¦aβ¦ ββ©β ββ©β (πβ¦ObjMapβ¦)"
by (metis π.NTDom.ObjMap.vdomain_atD π.NTDom.cf_ObjMap_vdomain)
show "π ββ©β B" by (intro π)
from a show "πβ¦ObjMapβ¦β¦aβ¦ ββ©β ββ©β (πβ¦ObjMapβ¦)"
by (metis π.NTCod.ObjMap.vdomain_atD π.NTCod.cf_ObjMap_vdomain)
show "πβ¦NTMapβ¦β¦aβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦aβ¦" by (intro πa)
qed
with a show "af ββ©β πβ¦Objβ¦ Γβ©β Hom_AB" unfolding af_def f_def by simp
qed
show "cf_map (ntcf_of_ntcf_arrow π π
πβ¦NTDomβ¦) ββ©β A"
unfolding π.ntcf_NTDom π(3)[symmetric] by (rule π)
show "cf_map (ntcf_of_ntcf_arrow π π
πβ¦NTCodβ¦) ββ©β B"
unfolding π.ntcf_NTCod π(4)[symmetric] by (rule π)
qed
qed
ultimately show "(ββ©βaββ©βA. ββ©βbββ©βB. Hom (dg_Funct Ξ± π π
) a b) ββ©β Vset Ξ±"
by blast
qed (unfold dg_Funct_components, auto)
subsubsectionβΉβΉFunctβΊ is a subdigraph of βΉFUNCTβΊβΊ
lemma (in π΅) subdigraph_dg_Funct_dg_FUNCT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "tiny_category Ξ± π" and "category Ξ± π
"
shows "dg_Funct Ξ± π π
ββ©Dβ©GβΞ²β dg_FUNCT Ξ± π π
"
proof(intro subdigraphI, unfold dg_FUNCT_components(1) dg_Funct_components(1))
interpret Ξ²: π΅ Ξ² by (rule assms(1))
show "digraph Ξ² (dg_Funct Ξ± π π
)"
by (intro digraph.dg_digraph_if_ge_Limit[OF digraph_dg_Funct] assms)
from assms show "digraph Ξ² (dg_FUNCT Ξ± π π
)"
by (cs_concl cs_intro: dg_small_cs_intros tiny_digraph_dg_FUNCT)
show "π ββ©β cf_maps Ξ± π π
" if "π ββ©β tm_cf_maps Ξ± π π
" for π
using that by (cs_concl cs_intro: dg_FUNCT_cs_intros tm_cf_maps_in_cf_maps)
show "π : π β¦βdg_FUNCT Ξ± π π
β π" if "π : π β¦βdg_Funct Ξ± π π
β π"
for π π π
proof-
note f = dg_Funct_is_arrD[OF that]
from f(1) show ?thesis
by (subst f(2), use nothing in βΉsubst f(3), subst f(4)βΊ)
(cs_concl cs_intro: dg_FUNCT_cs_intros cat_small_cs_intros)
qed
qed
textβΉ\newpageβΊ
end
Theory CZH_SMC_FUNCT
sectionβΉβΉFUNCTβΊ and βΉFunctβΊ as semicategories\label{sec:smc_FUNCT}βΊ
theory CZH_SMC_FUNCT
imports
CZH_DG_FUNCT
CZH_Foundations.CZH_SMC_Subsemicategory
begin
subsectionβΉBackgroundβΊ
textβΉ
The subsection presents the theory of the semicategories of βΉΞ±βΊ-functors
between two βΉΞ±βΊ-categories.
It continues the development that was initiated in section
\ref{sec:dg_FUNCT}.
A general reference for this section is Chapter II-4 in
\cite{mac_lane_categories_2010}.
βΊ
named_theorems smc_FUNCT_cs_simps
named_theorems smc_FUNCT_cs_intros
lemmas [smc_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [smc_FUNCT_cs_intros] = cat_map_cs_intros
subsectionβΉβΉFUNCTβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition smc_FUNCT :: "V β V β V β V"
where "smc_FUNCT Ξ± π π
=
[
cf_maps Ξ± π π
,
ntcf_arrows Ξ± π π
,
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_FUNCT Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)
]β©β"
textβΉComponents.βΊ
lemma smc_FUNCT_components:
shows "smc_FUNCT Ξ± π π
β¦Objβ¦ = cf_maps Ξ± π π
"
and "smc_FUNCT Ξ± π π
β¦Arrβ¦ = ntcf_arrows Ξ± π π
"
and "smc_FUNCT Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "smc_FUNCT Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
and "smc_FUNCT Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_FUNCT Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
unfolding smc_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smc_dg_FUNCT: "smc_dg (smc_FUNCT Ξ± π π
) = dg_FUNCT Ξ± π π
"
proof(rule vsv_eqI)
show "vsv (smc_dg (smc_FUNCT Ξ± π π
))" unfolding smc_dg_def by auto
show "vsv (dg_FUNCT Ξ± π π
)" unfolding dg_FUNCT_def by auto
have dom_lhs: "πβ©β (smc_dg (smc_FUNCT Ξ± π π
)) = 4β©β"
unfolding smc_dg_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (dg_FUNCT Ξ± π π
) = 4β©β"
unfolding dg_FUNCT_def by (simp add: nat_omega_simps)
show "πβ©β (smc_dg (smc_FUNCT Ξ± π π
)) = πβ©β (dg_FUNCT Ξ± π π
)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (smc_dg (smc_FUNCT Ξ± π π
)) βΉ
smc_dg (smc_FUNCT Ξ± π π
)β¦aβ¦ = dg_FUNCT Ξ± π π
β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold smc_dg_def dg_field_simps smc_FUNCT_def dg_FUNCT_def
)
(auto simp: nat_omega_simps)
qed
context is_ntcf
begin
lemmas_with [folded smc_dg_FUNCT, unfolded slicing_simps]:
smc_FUNCT_Dom_app = dg_FUNCT_Dom_app
and smc_FUNCT_Cod_app = dg_FUNCT_Cod_app
end
lemmas [smc_FUNCT_cs_simps] =
is_ntcf.smc_FUNCT_Dom_app
is_ntcf.smc_FUNCT_Cod_app
lemmas_with [folded smc_dg_FUNCT, unfolded slicing_simps]:
smc_FUNCT_Dom_vsv[intro] = dg_FUNCT_Dom_vsv
and smc_FUNCT_Dom_vdomain[smc_FUNCT_cs_simps] = dg_FUNCT_Dom_vdomain
and smc_FUNCT_Cod_vsv[intro] = dg_FUNCT_Cod_vsv
and smc_FUNCT_Cod_vdomain[smc_FUNCT_cs_simps] = dg_FUNCT_Cod_vdomain
and smc_FUNCT_Dom_vrange = dg_FUNCT_Dom_vrange
and smc_FUNCT_Cod_vrange = dg_FUNCT_Cod_vrange
and smc_FUNCT_is_arrI = dg_FUNCT_is_arrI
and smc_FUNCT_is_arrI'[smc_FUNCT_cs_intros] = dg_FUNCT_is_arrI'
and smc_FUNCT_is_arrD = dg_FUNCT_is_arrD
and smc_FUNCT_is_arrE[elim] = dg_FUNCT_is_arrE
subsubsectionβΉComposable arrowsβΊ
lemma smc_FUNCT_composable_arrs_dg_FUNCT:
"composable_arrs (dg_FUNCT Ξ± π π
) = composable_arrs (smc_FUNCT Ξ± π π
)"
unfolding composable_arrs_def smc_dg_FUNCT[symmetric] slicing_simps by auto
lemma smc_FUNCT_Comp:
"smc_FUNCT Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (smc_FUNCT Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
unfolding smc_FUNCT_components smc_FUNCT_composable_arrs_dg_FUNCT ..
subsubsectionβΉCompositionβΊ
lemma smc_FUNCT_Comp_vsv[intro]: "vsv (smc_FUNCT Ξ± π π
β¦Compβ¦)"
unfolding smc_FUNCT_Comp by simp
lemma smc_FUNCT_Comp_vdomain:
"πβ©β (smc_FUNCT Ξ± π π
β¦Compβ¦) = composable_arrs (smc_FUNCT Ξ± π π
)"
unfolding smc_FUNCT_Comp by auto
lemma smc_FUNCT_Comp_app[smc_FUNCT_cs_simps]:
assumes "π : π β¦βsmc_FUNCT Ξ± π π
β β" and "π : π β¦βsmc_FUNCT Ξ± π π
β π"
shows "π ββ©Aβsmc_FUNCT Ξ± π π
β π = π ββ©Nβ©Tβ©Cβ©Fβπ,π
β π"
proof-
from assms have "[π, π]β©β ββ©β composable_arrs (smc_FUNCT Ξ± π π
)"
by (auto intro: smc_cs_intros)
then show "π ββ©Aβsmc_FUNCT Ξ± π π
β π = π ββ©Nβ©Tβ©Cβ©Fβπ,π
β π"
unfolding smc_FUNCT_Comp by (simp add: nat_omega_simps)
qed
lemma smc_FUNCT_Comp_vrange: "ββ©β (smc_FUNCT Ξ± π π
β¦Compβ¦) ββ©β ntcf_arrows Ξ± π π
"
proof(rule vsubsetI)
fix π assume prems: "π ββ©β ββ©β (smc_FUNCT Ξ± π π
β¦Compβ¦)"
then obtain ππ
where π_def: "π = smc_FUNCT Ξ± π π
β¦Compβ¦β¦ππβ¦"
and "ππ ββ©β πβ©β (smc_FUNCT Ξ± π π
β¦Compβ¦)"
unfolding smc_FUNCT_components by (auto intro: smc_cs_intros)
then obtain π π π π β
where "ππ = [π, π]β©β"
and π: "π : π β¦βsmc_FUNCT Ξ± π π
β β"
and π: "π : π β¦βsmc_FUNCT Ξ± π π
β π"
by (auto simp: smc_FUNCT_Comp_vdomain)
with π_def have π_def': "π = π ββ©Aβsmc_FUNCT Ξ± π π
β π" by simp
note π = smc_FUNCT_is_arrD[OF π]
and π = smc_FUNCT_is_arrD[OF π]
from π(1) π(1) show "π ββ©β ntcf_arrows Ξ± π π
"
unfolding π_def'
by (subst π(2), subst π(2), remdups)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps cs_intro: cat_cs_intros smc_FUNCT_cs_intros
)
qed
subsubsectionβΉβΉFUNCTβΊ is a semicategoryβΊ
lemma (in π΅) tiny_semicategory_smc_FUNCT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_semicategory Ξ² (smc_FUNCT Ξ± π π
)"
proof(intro tiny_semicategoryI)
show "vfsequence (smc_FUNCT Ξ± π π
)" by (simp add: smc_FUNCT_def)
show "vcard (smc_FUNCT Ξ± π π
) = 5β©β"
unfolding smc_FUNCT_def by (simp add: nat_omega_simps)
show "(ππ ββ©β πβ©β (smc_FUNCT Ξ± π π
β¦Compβ¦)) =
(
βπ π π β π.
ππ = [π, π]β©β β§
π : π β¦βsmc_FUNCT Ξ± π π
β β β§
π : π β¦βsmc_FUNCT Ξ± π π
β π
)"
for ππ
unfolding smc_FUNCT_Comp by (auto intro: smc_cs_intros)
show Comp_is_arr: "π ββ©Aβsmc_FUNCT Ξ± π π
β π : π β¦βsmc_FUNCT Ξ± π π
β β"
if "π : π β¦βsmc_FUNCT Ξ± π π
β β" and "π : π β¦βsmc_FUNCT Ξ± π π
β π"
for π π β π π
proof-
note g = smc_FUNCT_is_arrD[OF that(1)]
note f = smc_FUNCT_is_arrD[OF that(2)]
from g(1) f(1) show "π ββ©Aβsmc_FUNCT Ξ± π π
β π : π β¦βsmc_FUNCT Ξ± π π
β β"
by (subst g(2), subst g(4), subst f(2), subst f(3), remdups)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_cs_intros
)
qed
fix π β π π π π π
assume prems:
"π : β β¦βsmc_FUNCT Ξ± π π
β π"
"π : π β¦βsmc_FUNCT Ξ± π π
β β"
"π : π β¦βsmc_FUNCT Ξ± π π
β π"
note π = smc_FUNCT_is_arrD[OF prems(1)]
note π = smc_FUNCT_is_arrD[OF prems(2)]
note π = smc_FUNCT_is_arrD[OF prems(3)]
from π(1) π(1) π(1) show
"(π ββ©Aβsmc_FUNCT Ξ± π π
β π) ββ©Aβsmc_FUNCT Ξ± π π
β π =
π ββ©Aβsmc_FUNCT Ξ± π π
β (π ββ©Aβsmc_FUNCT Ξ± π π
β π)"
by (subst (1 2) π(2), subst (1 2) π(2), subst (1 2) π(2), remdups)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps cat_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_cs_intros
)
qed
(
simp_all add:
assms
smc_dg_FUNCT
smc_FUNCT_components
tiny_digraph_dg_FUNCT[OF assms(1,2)]
)
subsectionβΉβΉFunctβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition smc_Funct :: "V β V β V β V"
where "smc_Funct Ξ± π π
=
[
tm_cf_maps Ξ± π π
,
tm_ntcf_arrows Ξ± π π
,
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_Funct Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)
]β©β"
textβΉComponents.βΊ
lemma smc_Funct_components:
shows "smc_Funct Ξ± π π
β¦Objβ¦ = tm_cf_maps Ξ± π π
"
and "smc_Funct Ξ± π π
β¦Arrβ¦ = tm_ntcf_arrows Ξ± π π
"
and "smc_Funct Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "smc_Funct Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
and "smc_Funct Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_Funct Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
unfolding smc_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma smc_dg_Funct: "smc_dg (smc_Funct Ξ± π π
) = dg_Funct Ξ± π π
"
proof(rule vsv_eqI)
show "vsv (smc_dg (smc_Funct Ξ± π π
))" unfolding smc_dg_def by auto
show "vsv (dg_Funct Ξ± π π
)" unfolding dg_Funct_def by auto
have dom_lhs: "πβ©β (smc_dg (smc_Funct Ξ± π π
)) = 4β©β"
unfolding smc_dg_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (dg_Funct Ξ± π π
) = 4β©β"
unfolding dg_Funct_def by (simp add: nat_omega_simps)
show "πβ©β (smc_dg (smc_Funct Ξ± π π
)) = πβ©β (dg_Funct Ξ± π π
)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (smc_dg (smc_Funct Ξ± π π
)) βΉ
smc_dg (smc_Funct Ξ± π π
)β¦aβ¦ = dg_Funct Ξ± π π
β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold smc_dg_def dg_field_simps smc_Funct_def dg_Funct_def
)
(auto simp: nat_omega_simps)
qed
context is_tm_ntcf
begin
lemmas_with [folded smc_dg_Funct, unfolded slicing_simps]:
smc_Funct_Dom_app = dg_Funct_Dom_app
and smc_Funct_Cod_app = dg_Funct_Cod_app
end
lemmas [smc_FUNCT_cs_simps] =
is_tm_ntcf.smc_Funct_Dom_app
is_tm_ntcf.smc_Funct_Cod_app
lemmas_with [folded smc_dg_Funct, unfolded slicing_simps]:
smc_Funct_Dom_vsv[intro] = dg_Funct_Dom_vsv
and smc_Funct_Dom_vdomain[smc_FUNCT_cs_simps] = dg_Funct_Dom_vdomain
and smc_Funct_Cod_vsv[intro] = dg_Funct_Cod_vsv
and smc_Funct_Cod_vdomain[smc_FUNCT_cs_simps] = dg_Funct_Cod_vdomain
and smc_Funct_Dom_vrange = dg_Funct_Dom_vrange
and smc_Funct_Cod_vrange = dg_Funct_Cod_vrange
and smc_Funct_is_arrI = dg_Funct_is_arrI
and smc_Funct_is_arrI'[smc_FUNCT_cs_intros] = dg_Funct_is_arrI'
and smc_Funct_is_arrD = dg_Funct_is_arrD
and smc_Funct_is_arrE[elim] = dg_Funct_is_arrE
subsubsectionβΉComposable arrowsβΊ
lemma smc_Funct_composable_arrs_dg_FUNCT:
"composable_arrs (dg_Funct Ξ± π π
) = composable_arrs (smc_Funct Ξ± π π
)"
unfolding composable_arrs_def smc_dg_Funct[symmetric] slicing_simps by auto
lemma smc_Funct_Comp:
"smc_Funct Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (smc_Funct Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
unfolding smc_Funct_components smc_Funct_composable_arrs_dg_FUNCT ..
subsubsectionβΉCompositionβΊ
lemma smc_Funct_Comp_vsv[intro]: "vsv (smc_Funct Ξ± π π
β¦Compβ¦)"
unfolding smc_Funct_Comp by simp
lemma smc_Funct_Comp_vdomain:
"πβ©β (smc_Funct Ξ± π π
β¦Compβ¦) = composable_arrs (smc_Funct Ξ± π π
)"
unfolding smc_Funct_Comp by auto
lemma smc_Funct_Comp_app[smc_FUNCT_cs_simps]:
assumes "π : π β¦βsmc_Funct Ξ± π π
β β" and "π : π β¦βsmc_Funct Ξ± π π
β π"
shows "π ββ©Aβsmc_Funct Ξ± π π
β π = π ββ©Nβ©Tβ©Cβ©Fβπ,π
β π"
proof-
from assms have "[π, π]β©β ββ©β composable_arrs (smc_Funct Ξ± π π
)"
by (auto intro: smc_cs_intros)
then show "π ββ©Aβsmc_Funct Ξ± π π
β π = π ββ©Nβ©Tβ©Cβ©Fβπ,π
β π"
unfolding smc_Funct_Comp by (simp add: nat_omega_simps)
qed
lemma smc_Funct_Comp_vrange:
assumes "category Ξ± π
"
shows "ββ©β (smc_Funct Ξ± π π
β¦Compβ¦) ββ©β tm_ntcf_arrows Ξ± π π
"
proof(rule vsubsetI)
fix π assume "π ββ©β ββ©β (smc_Funct Ξ± π π
β¦Compβ¦)"
then obtain ππ
where π_def: "π = smc_Funct Ξ± π π
β¦Compβ¦β¦ππβ¦"
and "ππ ββ©β πβ©β (smc_Funct Ξ± π π
β¦Compβ¦)"
unfolding smc_Funct_components
by (auto intro: smc_cs_intros)
then obtain π π π π β
where "ππ = [π, π]β©β"
and π: "π : π β¦βsmc_Funct Ξ± π π
β β"
and π: "π : π β¦βsmc_Funct Ξ± π π
β π"
by (auto simp: smc_Funct_Comp_vdomain)
with π_def have π_def': "π = π ββ©Aβsmc_Funct Ξ± π π
β π" by simp
note π = smc_Funct_is_arrD[OF π]
and π = smc_Funct_is_arrD[OF π]
from assms π(1) π(1) show "π ββ©β tm_ntcf_arrows Ξ± π π
"
unfolding π_def'
by (subst π(2), use nothing in βΉsubst π(2)βΊ)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
)
qed
subsubsectionβΉβΉFunctβΊ is a semicategoryβΊ
lemma semicategory_smc_Funct:
assumes "tiny_category Ξ± π" and "category Ξ± π
"
shows "semicategory Ξ± (smc_Funct Ξ± π π
)" (is βΉsemicategory Ξ± ?FunctβΊ)
proof-
interpret tiny_category Ξ± π by (rule assms(1))
show ?thesis
proof(intro semicategoryI)
show "vfsequence ?Funct" by (simp add: smc_Funct_def)
show "vcard ?Funct = 5β©β"
unfolding smc_Funct_def by (simp add: nat_omega_simps)
show "(ππ ββ©β πβ©β (smc_Funct Ξ± π π
β¦Compβ¦)) =
(βπ π π β π. ππ = [π, π]β©β β§ π : π β¦β?Functβ β β§ π : π β¦β?Functβ π)"
for ππ
unfolding smc_Funct_Comp by (auto intro: smc_cs_intros)
show Comp_is_arr: "π ββ©Aβ?Functβ π : π β¦β?Functβ β"
if "π : π β¦β?Functβ β" and "π : π β¦β?Functβ π"
for π π β π π
proof-
note π = smc_Funct_is_arrD[OF that(1)]
note π = smc_Funct_is_arrD[OF that(2)]
from assms π(1) π(1) show
"π ββ©Aβ?Functβ π : π β¦β?Functβ β"
by (subst π(2), use nothing in βΉsubst π(4), subst π(2), subst π(3)βΊ)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
)
qed
show "π ββ©Aβ?Functβ π ββ©Aβ?Functβ π = π ββ©Aβ?Functβ (π ββ©Aβ?Functβ π)"
if "π : β β¦β?Functβ π" "π : π β¦β?Functβ β" "π : π β¦β?Functβ π"
for π β π π π π π
proof-
note π = smc_Funct_is_arrD[OF that(1)]
note π = smc_Funct_is_arrD[OF that(2)]
note π = smc_Funct_is_arrD[OF that(3)]
from assms π(1) π(1) π(1) show
"(π ββ©Aβ?Functβ π) ββ©Aβ?Functβ π = π ββ©Aβ?Functβ (π ββ©Aβ?Functβ π)"
by
(
subst (1 2) π(2),
use nothing in βΉsubst (1 2) π(2), subst (1 2) π(2)βΊ
)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps cat_cs_simps cat_small_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_cs_intros cat_small_cs_intros
)
qed
qed (auto simp: assms smc_dg_Funct smc_Funct_components digraph_dg_Funct)
qed
subsubsectionβΉβΉFunctβΊ is a subsemicategory of βΉFUNCTβΊβΊ
lemma subsemicategory_smc_Funct_smc_FUNCT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "tiny_category Ξ± π" and "category Ξ± π
"
shows "smc_Funct Ξ± π π
ββ©Sβ©Mβ©CβΞ²β smc_FUNCT Ξ± π π
"
proof(intro subsemicategoryI, unfold smc_dg_FUNCT smc_dg_Funct)
interpret category Ξ± π
by (rule assms(4))
interpret smc_Funct: semicategory Ξ± βΉsmc_Funct Ξ± π π
βΊ
by (rule semicategory_smc_Funct[OF assms(3,4)])
show "semicategory Ξ² (smc_Funct Ξ± π π
)"
by (rule semicategory.smc_semicategory_if_ge_Limit[OF _ assms(1,2)])
(auto simp: smc_cs_simps intro: smc_cs_intros)
from assms show "semicategory Ξ² (smc_FUNCT Ξ± π π
)"
by
(
cs_concl
cs_intro: smc_small_cs_intros tiny_semicategory_smc_FUNCT
)
show "dg_Funct Ξ± π π
ββ©Dβ©GβΞ²β dg_FUNCT Ξ± π π
"
by (rule subdigraph_dg_Funct_dg_FUNCT[OF assms])
show "π ββ©Aβsmc_Funct Ξ± π π
β π = π ββ©Aβsmc_FUNCT Ξ± π π
β π"
if "π : π β¦βsmc_Funct Ξ± π π
β β" and "π : π β¦βsmc_Funct Ξ± π π
β π"
for π β π π π
proof-
note π = smc_Funct_is_arrD[OF that(1)]
note π = smc_Funct_is_arrD[OF that(2)]
from π(1) π(1) show ?thesis
by (subst (1 2) π(2), use nothing in βΉsubst (1 2) π(2)βΊ)
(
cs_concl
cs_simp: smc_FUNCT_cs_simps cat_small_cs_simps
cs_intro: smc_FUNCT_cs_intros cat_small_cs_intros
)
qed
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_FUNCT
sectionβΉβΉFUNCTβΊ and βΉFunctβΊβΊ
theory CZH_ECAT_FUNCT
imports
CZH_SMC_FUNCT
CZH_ECAT_Subcategory
CZH_ECAT_NTCF
begin
subsectionβΉBackgroundβΊ
textβΉ
The subsection presents the theory of the categories of βΉΞ±βΊ-functors
between two βΉΞ±βΊ-categories.
It continues the development that was initiated in sections
\ref{sec:dg_FUNCT} and \ref{sec:smc_FUNCT}.
A general reference for this section is Chapter II-4 in
\cite{mac_lane_categories_2010}.
βΊ
named_theorems cat_FUNCT_cs_simps
named_theorems cat_FUNCT_cs_intros
lemmas [cat_FUNCT_cs_simps] = cat_map_cs_simps
lemmas [cat_FUNCT_cs_intros] = cat_map_cs_intros
subsectionβΉβΉFUNCTβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_FUNCT :: "V β V β V β V"
where "cat_FUNCT Ξ± π π
=
[
cf_maps Ξ± π π
,
ntcf_arrows Ξ± π π
,
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_FUNCT Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦),
(Ξ»πββ©βcf_maps Ξ± π π
. ntcf_arrow_id π π
π)
]β©β"
textβΉComponents.βΊ
lemma cat_FUNCT_components:
shows [cat_FUNCT_cs_simps]: "cat_FUNCT Ξ± π π
β¦Objβ¦ = cf_maps Ξ± π π
"
and "cat_FUNCT Ξ± π π
β¦Arrβ¦ = ntcf_arrows Ξ± π π
"
and "cat_FUNCT Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "cat_FUNCT Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
and "cat_FUNCT Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_FUNCT Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
and "cat_FUNCT Ξ± π π
β¦CIdβ¦ = (Ξ»πββ©βcf_maps Ξ± π π
. ntcf_arrow_id π π
π)"
unfolding cat_FUNCT_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_FUNCT: "cat_smc (cat_FUNCT Ξ± π π
) = smc_FUNCT Ξ± π π
"
proof(rule vsv_eqI)
show "vsv (cat_smc (cat_FUNCT Ξ± π π
))" unfolding cat_smc_def by auto
show "vsv (smc_FUNCT Ξ± π π
)" unfolding smc_FUNCT_def by auto
have dom_lhs: "πβ©β (cat_smc (cat_FUNCT Ξ± π π
)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_FUNCT Ξ± π π
) = 5β©β"
unfolding smc_FUNCT_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_FUNCT Ξ± π π
)) = πβ©β (smc_FUNCT Ξ± π π
)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_FUNCT Ξ± π π
)) βΉ
cat_smc (cat_FUNCT Ξ± π π
)β¦aβ¦ = smc_FUNCT Ξ± π π
β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_FUNCT_def smc_FUNCT_def
)
(auto simp: nat_omega_simps)
qed
context is_ntcf
begin
lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
cat_FUNCT_Dom_app = smc_FUNCT_Dom_app
and cat_FUNCT_Cod_app = smc_FUNCT_Cod_app
end
lemmas [smc_FUNCT_cs_simps] =
is_ntcf.cat_FUNCT_Dom_app
is_ntcf.cat_FUNCT_Cod_app
lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
cat_FUNCT_Dom_vsv[intro] = smc_FUNCT_Dom_vsv
and cat_FUNCT_Dom_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Dom_vdomain
and cat_FUNCT_Cod_vsv[intro] = smc_FUNCT_Cod_vsv
and cat_FUNCT_Cod_vdomain[cat_FUNCT_cs_simps] = smc_FUNCT_Cod_vdomain
and cat_FUNCT_Dom_vrange = smc_FUNCT_Dom_vrange
and cat_FUNCT_Cod_vrange = smc_FUNCT_Cod_vrange
and cat_FUNCT_is_arrI = smc_FUNCT_is_arrI
and cat_FUNCT_is_arrI'[cat_FUNCT_cs_intros] = smc_FUNCT_is_arrI'
and cat_FUNCT_is_arrD = smc_FUNCT_is_arrD
and cat_FUNCT_is_arrE[elim] = smc_FUNCT_is_arrE
lemmas_with [folded cat_smc_FUNCT, unfolded slicing_simps]:
cat_FUNCT_Comp_app[cat_FUNCT_cs_simps] = smc_FUNCT_Comp_app
subsubsectionβΉIdentityβΊ
mk_VLambda cat_FUNCT_components(6)
|vsv cat_FUNCT_CId_vsv[cat_FUNCT_cs_intros]|
|vdomain cat_FUNCT_CId_vdomain[cat_FUNCT_cs_simps]|
|app cat_FUNCT_CId_app[cat_FUNCT_cs_simps]|
lemma smc_FUNCT_CId_vrange: "ββ©β (cat_FUNCT Ξ± π π
β¦CIdβ¦) ββ©β ntcf_arrows Ξ± π π
"
unfolding cat_FUNCT_components
proof(rule vrange_VLambda_vsubset)
fix x assume "x ββ©β cf_maps Ξ± π π
"
then obtain π where x_def: "x = cf_map π" and π: "π : π β¦β¦β©CβΞ±β π
"
by clarsimp
then show "ntcf_arrow_id π π
x ββ©β ntcf_arrows Ξ± π π
"
unfolding x_def
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
subsubsectionβΉ
The conversion of a natural transformation arrow
to a natural transformation is a bijection
βΊ
lemma bij_betw_ntcf_of_ntcf_arrow:
"bij_betw
(ntcf_of_ntcf_arrow π π
)
(elts (ntcf_arrows Ξ± π π
))
(elts (ntcfs Ξ± π π
))"
proof(intro bij_betw_imageI inj_onI subset_antisym subsetI)
fix π π assume prems:
"π ββ©β ntcf_arrows Ξ± π π
"
"π ββ©β ntcf_arrows Ξ± π π
"
"ntcf_of_ntcf_arrow π π
π = ntcf_of_ntcf_arrow π π
π"
from prems(1) obtain π' π π
where π_def: "π = ntcf_arrow π'" and π': "π' : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
from prems(2) obtain π' π' π'
where π_def: "π = ntcf_arrow π'" and π': "π' : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
by auto
from prems(3) have "π' = π'"
unfolding
π_def
π_def
is_ntcf.ntcf_of_ntcf_arrow[OF π']
is_ntcf.ntcf_of_ntcf_arrow[OF π']
by simp
then show "π = π" unfolding π_def π_def by auto
next
fix π assume
"π β ntcf_of_ntcf_arrow π π
` elts (ntcf_arrows Ξ± π π
)"
then obtain π' where π': "π' ββ©β ntcf_arrows Ξ± π π
"
and π_def: "π = ntcf_of_ntcf_arrow π π
π'"
by auto
from π' obtain π'' π π
where π'_def: "π' = ntcf_arrow π''"
and π'': "π'' : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
by auto
from π'' show "π ββ©β ntcfs Ξ± π π
"
unfolding π_def π'_def is_ntcf.ntcf_of_ntcf_arrow[OF π''] by auto
next
fix π assume "π ββ©β ntcfs Ξ± π π
"
then obtain π π where π: "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by clarsimp
then have "π = ntcf_of_ntcf_arrow π π
(ntcf_arrow π)"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
moreover from π have "ntcf_arrow π ββ©β ntcf_arrows Ξ± π π
"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
ultimately show "π β ntcf_of_ntcf_arrow π π
` elts (ntcf_arrows Ξ± π π
)"
by simp
qed
lemma bij_betw_ntcf_of_ntcf_arrow_Hom:
assumes "π : π β¦β¦β©CβΞ±β π
" and "π : π β¦β¦β©CβΞ±β π
"
shows "bij_betw
(ntcf_of_ntcf_arrow π π
)
(elts (Hom (cat_FUNCT Ξ± π π
) (cf_map π) (cf_map π)))
(elts (these_ntcfs Ξ± π π
π π))"
proof-
interpret π: is_functor Ξ± π π
π by (rule assms(1))
interpret π: is_functor Ξ± π π
π by (rule assms(2))
from assms have [cat_cs_simps]:
"cf_of_cf_map π π
(cf_map π) = π"
"cf_of_cf_map π π
(cf_map π) = π"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)+
show ?thesis
proof
(
rule bij_betw_subset[OF bij_betw_ntcf_of_ntcf_arrow];
(intro subset_antisym subsetI)?;
(unfold in_Hom_iff)?
)
fix π assume prems: "π : cf_map π β¦βcat_FUNCT Ξ± π π
β cf_map π"
note π = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
from π(1) show "π ββ©β ntcf_arrows Ξ± π π
"
by (subst π(2)) (cs_concl cs_intro: cat_FUNCT_cs_intros)
next
fix π assume
"π β ntcf_of_ntcf_arrow π π
`
elts (Hom (cat_FUNCT Ξ± π π
) (cf_map π) (cf_map π))"
then obtain π'
where π': "π' ββ©β Hom (cat_FUNCT Ξ± π π
) (cf_map π) (cf_map π)"
and π_def: "π = ntcf_of_ntcf_arrow π π
π'"
by auto
note π' = cat_FUNCT_is_arrD[
OF π'[unfolded cat_cs_simps], unfolded cat_cs_simps
]
from π'(1) show "π ββ©β these_ntcfs Ξ± π π
π π" unfolding π_def by simp
next
fix π assume "π ββ©β these_ntcfs Ξ± π π
π π"
then have π: "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
" by simp
then have "π = ntcf_of_ntcf_arrow π π
(ntcf_arrow π)"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
moreover from π have
"ntcf_arrow π ββ©β Hom (cat_FUNCT Ξ± π π
) (cf_map π) (cf_map π)"
unfolding in_Hom_iff by (cs_concl cs_intro: cat_FUNCT_cs_intros)
ultimately show
"π β ntcf_of_ntcf_arrow π π
`
elts (Hom (cat_FUNCT Ξ± π π
) (cf_map π) (cf_map π))"
by simp
qed
qed
subsubsectionβΉβΉFUNCTβΊ is a categoryβΊ
lemma (in π΅) tiny_category_cat_FUNCT[cat_FUNCT_cs_intros]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "tiny_category Ξ² (cat_FUNCT Ξ± π π
)" (is βΉtiny_category Ξ² ?FUNCTβΊ)
proof(intro tiny_categoryI)
show "vfsequence ?FUNCT" unfolding cat_FUNCT_def by auto
show "vcard ?FUNCT = 6β©β"
unfolding cat_FUNCT_def by (simp add: nat_omega_simps)
from assms show "tiny_semicategory Ξ² (cat_smc ?FUNCT)"
unfolding cat_smc_FUNCT
by (auto simp add: tiny_semicategory_smc_FUNCT)
show CId_a: "?FUNCTβ¦CIdβ¦β¦π'β¦ : π' β¦β?FUNCTβ π'" if "π' ββ©β ?FUNCTβ¦Objβ¦" for π'
proof-
from that obtain π where π'_def: "π' = cf_map π" and π: "π : π β¦β¦β©CβΞ±β π
"
unfolding cat_FUNCT_components by clarsimp
show ?thesis
using that π
unfolding cat_FUNCT_components(1) π'_def
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show "?FUNCTβ¦CIdβ¦β¦πβ¦ ββ©Aβ?FUNCTβ π = π" if "π : π β¦β?FUNCTβ π" for π π π
proof-
from that obtain π' π' π'
where π': "π' : π' β¦β©Cβ©F π' : π β¦β¦β©CβΞ±β π
"
and π_def[cat_FUNCT_cs_simps]: "π = ntcf_arrow π'"
and π_def[cat_FUNCT_cs_simps]: "π = cf_map π'"
and π_def[cat_FUNCT_cs_simps]: "π = cf_map π'"
by auto
from π' show "cat_FUNCT Ξ± π π
β¦CIdβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π π
β π = π"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show "π ββ©Aβ?FUNCTβ ?FUNCTβ¦CIdβ¦β¦πβ¦ = π" if "π : π β¦β?FUNCTβ β" for π π β
proof-
note π = cat_FUNCT_is_arrD[OF that]
from π(1) show "π ββ©Aβcat_FUNCT Ξ± π π
β cat_FUNCT Ξ± π π
β¦CIdβ¦β¦πβ¦ = π"
by (subst (1 2) π(2), subst π(3), remdups)
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed (simp_all add: assms cat_FUNCT_components)
lemmas (in π΅) [cat_FUNCT_cs_intros] = tiny_category_cat_FUNCT
subsubsectionβΉIsomorphismβΊ
lemma (in π΅) cat_FUNCT_is_arr_isomorphismI:
assumes "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
shows "ntcf_arrow π : cf_map π β¦β©iβ©sβ©oβcat_FUNCT Ξ± π π
β cf_map π"
proof(intro is_arr_isomorphismI is_inverseI)
interpret π: is_iso_ntcf Ξ± π π
π π π by (rule assms)
show is_arr_π: "ntcf_arrow π : cf_map π β¦βcat_FUNCT Ξ± π π
β cf_map π"
by (simp add: assms cat_FUNCT_is_arrI is_iso_ntcf.axioms(1))
interpret inv_π: is_iso_ntcf Ξ± π π
π π βΉinv_ntcf πβΊ
using CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF assms] by simp
from assms show is_arr_inv_π:
"ntcf_arrow (inv_ntcf π) : cf_map π β¦βcat_FUNCT Ξ± π π
β cf_map π"
by
(
cs_concl cs_intro:
ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms show "ntcf_arrow π : cf_map π β¦βcat_FUNCT Ξ± π π
β cf_map π"
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms show
"ntcf_arrow (inv_ntcf π) ββ©Aβcat_FUNCT Ξ± π π
β ntcf_arrow π =
cat_FUNCT Ξ± π π
β¦CIdβ¦β¦cf_map πβ¦"
"ntcf_arrow π ββ©Aβcat_FUNCT Ξ± π π
β ntcf_arrow (inv_ntcf π) =
cat_FUNCT Ξ± π π
β¦CIdβ¦β¦cf_map πβ¦"
by
(
cs_concl
cs_simp: iso_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
cs_intro: ntcf_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma (in π΅) cat_FUNCT_is_arr_isomorphismI':
assumes "π' = ntcf_arrow π"
and "π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π β¦β¦β©CβΞ±β π
"
and "π' = cf_map π"
and "π' = cf_map π"
shows "π' : π' β¦β©iβ©sβ©oβcat_FUNCT Ξ± π π
β cf_map π"
using assms(2) unfolding assms(1,3,4) by (rule cat_FUNCT_is_arr_isomorphismI)
lemmas [cat_FUNCT_cs_intros] = π΅.cat_FUNCT_is_arr_isomorphismI'[rotated 2]
lemma (in π΅) cat_FUNCT_is_arr_isomorphismD:
assumes "π : π β¦β©iβ©sβ©oβcat_FUNCT Ξ± π π
β π" (is βΉπ : π β¦β©iβ©sβ©oβ?FUNCTβ πβΊ)
shows "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_of_cf_map π π
π : π β¦β¦β©CβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
proof-
define Ξ² where "Ξ² = Ξ± + Ο"
have π΅Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: π΅_Ξ±_Ξ±Ο π΅.intro π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο Ξ²_def)
interpret FUNCT: tiny_category Ξ² ?FUNCT
by (rule tiny_category_cat_FUNCT[OF π΅Ξ² Ξ±Ξ², of π π
])
have inv_π: "πΒ―β©Cβ?FUNCTβ : π β¦β©iβ©sβ©oβ?FUNCTβ π"
and inv_π_π: "πΒ―β©Cβ?FUNCTβ ββ©Aβ?FUNCTβ π = ?FUNCTβ¦CIdβ¦β¦πβ¦"
and π_inv_π: "π ββ©Aβ?FUNCTβ πΒ―β©Cβ?FUNCTβ = ?FUNCTβ¦CIdβ¦β¦πβ¦"
by
(
intro
FUNCT.cat_the_inverse_is_arr_isomorphism[OF assms]
FUNCT.cat_the_inverse_Comp_CId[OF assms]
)+
from assms is_arr_isomorphismD inv_π
have π_is_arr: "π : π β¦βcat_FUNCT Ξ± π π
β π"
and inv_π_is_arr: "πΒ―β©Cβ?FUNCTβ : π β¦βcat_FUNCT Ξ± π π
β π"
by auto
note π_is_arr = cat_FUNCT_is_arrD[OF π_is_arr]
note inv_π_is_arr = cat_FUNCT_is_arrD[OF inv_π_is_arr]
let ?π = βΉntcf_of_ntcf_arrow π π
πβΊ
and ?inv_π = βΉntcf_of_ntcf_arrow π π
(πΒ―β©Cβcat_FUNCT Ξ± π π
β)βΊ
from inv_π_π π_is_arr(1) inv_π_is_arr(1) have inv_π_π:
"?inv_π ββ©Nβ©Tβ©Cβ©F ?π = ntcf_id (cf_of_cf_map π π
π)"
by
(
subst (asm) inv_π_is_arr(2),
use nothing in βΉsubst (asm) (2) π_is_arr(2), subst (asm) π_is_arr(3)βΊ
)
(
cs_prems
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_cs_intros
)
from π_inv_π inv_π_is_arr(1) π_is_arr(1) have π_inv_π:
"?π ββ©Nβ©Tβ©Cβ©F ?inv_π = ntcf_id (cf_of_cf_map π π
π)"
by
(
subst (asm) inv_π_is_arr(2),
use nothing in βΉsubst (asm) π_is_arr(2), subst (asm) π_is_arr(4)βΊ
)
(
cs_prems
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_cs_intros
)
show "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_of_cf_map π π
π : π β¦β¦β©CβΞ±β π
"
by
(
rule CZH_ECAT_NTCF.is_arr_isomorphism_is_iso_ntcf[
OF π_is_arr(1) inv_π_is_arr(1) π_inv_π inv_π_π
]
)
show "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
by (intro π_is_arr(2-4))+
qed
subsectionβΉβΉFunctβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_Funct :: "V β V β V β V"
where "cat_Funct Ξ± π π
=
[
tm_cf_maps Ξ± π π
,
tm_ntcf_arrows Ξ± π π
,
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦),
(Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦),
(Ξ»ππββ©βcomposable_arrs (dg_Funct Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦),
(Ξ»πββ©βtm_cf_maps Ξ± π π
. ntcf_arrow_id π π
π)
]β©β"
textβΉComponents.βΊ
lemma cat_Funct_components:
shows "cat_Funct Ξ± π π
β¦Objβ¦ = tm_cf_maps Ξ± π π
"
and "cat_Funct Ξ± π π
β¦Arrβ¦ = tm_ntcf_arrows Ξ± π π
"
and "cat_Funct Ξ± π π
β¦Domβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTDomβ¦)"
and "cat_Funct Ξ± π π
β¦Codβ¦ = (Ξ»πββ©βtm_ntcf_arrows Ξ± π π
. πβ¦NTCodβ¦)"
and "cat_Funct Ξ± π π
β¦Compβ¦ =
(Ξ»ππββ©βcomposable_arrs (dg_Funct Ξ± π π
). ππβ¦0β¦ ββ©Nβ©Tβ©Cβ©Fβπ,π
β ππβ¦1β©ββ¦)"
and "cat_Funct Ξ± π π
β¦CIdβ¦ = (Ξ»πββ©βtm_cf_maps Ξ± π π
. ntcf_arrow_id π π
π)"
unfolding cat_Funct_def dg_field_simps by (simp_all add: nat_omega_simps)
textβΉSlicing.βΊ
lemma cat_smc_Funct: "cat_smc (cat_Funct Ξ± π π
) = smc_Funct Ξ± π π
"
proof(rule vsv_eqI)
show "vsv (cat_smc (cat_Funct Ξ± π π
))" unfolding cat_smc_def by auto
show "vsv (smc_Funct Ξ± π π
)" unfolding smc_Funct_def by auto
have dom_lhs: "πβ©β (cat_smc (cat_Funct Ξ± π π
)) = 5β©β"
unfolding cat_smc_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β (smc_Funct Ξ± π π
) = 5β©β"
unfolding smc_Funct_def by (simp add: nat_omega_simps)
show "πβ©β (cat_smc (cat_Funct Ξ± π π
)) = πβ©β (smc_Funct Ξ± π π
)"
unfolding dom_lhs dom_rhs by simp
show "a ββ©β πβ©β (cat_smc (cat_Funct Ξ± π π
)) βΉ
cat_smc (cat_Funct Ξ± π π
)β¦aβ¦ = smc_Funct Ξ± π π
β¦aβ¦"
for a
by
(
unfold dom_lhs,
elim_in_numeral,
unfold cat_smc_def dg_field_simps cat_Funct_def smc_Funct_def
)
(auto simp: nat_omega_simps)
qed
context is_tm_ntcf
begin
lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
cat_Funct_Dom_app = smc_Funct_Dom_app
and cat_Funct_Cod_app = smc_Funct_Cod_app
end
lemmas [cat_FUNCT_cs_simps] =
is_tm_ntcf.cat_Funct_Dom_app
is_tm_ntcf.cat_Funct_Cod_app
lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
cat_Funct_Dom_vsv[cat_FUNCT_cs_intros] = smc_Funct_Dom_vsv
and cat_Funct_Dom_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Dom_vdomain
and cat_Funct_Cod_vsv[cat_FUNCT_cs_intros] = smc_Funct_Cod_vsv
and cat_Funct_Cod_vdomain[cat_FUNCT_cs_simps] = smc_Funct_Cod_vdomain
and cat_Funct_Dom_vrange = smc_Funct_Dom_vrange
and cat_Funct_Cod_vrange = smc_Funct_Cod_vrange
and cat_Funct_is_arrI = smc_Funct_is_arrI
and cat_Funct_is_arrI'[cat_FUNCT_cs_intros] = smc_Funct_is_arrI'
and cat_Funct_is_arrD = smc_Funct_is_arrD
and cat_Funct_is_arrE[elim] = smc_Funct_is_arrE
lemmas_with [folded cat_smc_Funct, unfolded slicing_simps]:
cat_Funct_Comp_app[cat_FUNCT_cs_simps] = smc_Funct_Comp_app
subsubsectionβΉIdentityβΊ
mk_VLambda cat_Funct_components(6)
|vsv cat_Funct_CId_vsv[intro]|
|vdomain cat_Funct_CId_vdomain[cat_FUNCT_cs_simps]|
|app cat_Funct_CId_app[cat_FUNCT_cs_simps]|
lemma smc_Funct_CId_vrange: "ββ©β (cat_Funct Ξ± π π
β¦CIdβ¦) ββ©β ntcf_arrows Ξ± π π
"
unfolding cat_Funct_components
proof(rule vrange_VLambda_vsubset)
fix π' assume "π' ββ©β tm_cf_maps Ξ± π π
"
then obtain π where π'_def: "π' = cf_map π" and π: "π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by clarsimp
then show "ntcf_arrow_id π π
π' ββ©β ntcf_arrows Ξ± π π
"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps π'_def
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
qed
subsubsectionβΉβΉFunctβΊ is a categoryβΊ
lemma category_cat_Funct:
assumes "tiny_category Ξ± π" and "category Ξ± π
"
shows "category Ξ± (cat_Funct Ξ± π π
)" (is βΉcategory Ξ± ?FunctβΊ)
proof-
interpret tiny_category Ξ± π by (rule assms(1))
show ?thesis
proof(intro categoryI)
show "vfsequence ?Funct" by (simp add: cat_Funct_def)
show "vcard ?Funct = 6β©β"
unfolding cat_Funct_def by (simp add: nat_omega_simps)
from assms show "semicategory Ξ± (cat_smc (cat_Funct Ξ± π π
))"
unfolding cat_smc_Funct by (rule semicategory_smc_Funct)
show "πβ©β (cat_Funct Ξ± π π
β¦CIdβ¦) = cat_Funct Ξ± π π
β¦Objβ¦"
by (cs_concl cs_simp: cat_Funct_components cat_FUNCT_cs_simps)
show "cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ : π β¦βcat_Funct Ξ± π π
β π"
if "π ββ©β cat_Funct Ξ± π π
β¦Objβ¦" for π
proof-
from that have "π ββ©β tm_cf_maps Ξ± π π
"
unfolding cat_Funct_components by simp
then obtain π'
where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by auto
from assms π' show "cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ : π β¦βcat_Funct Ξ± π π
β π"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps π_def
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
qed
show "cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ ββ©Aβcat_Funct Ξ± π π
β π = π"
if "π : π β¦βcat_Funct Ξ± π π
β π" for π π π
proof-
note π = cat_Funct_is_arrD[OF that]
from assms π(1) show
"cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ ββ©Aβcat_Funct Ξ± π π
β π = π"
by (subst (1 2) π(2), use nothing in βΉsubst π(4)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
qed
show "π ββ©Aβcat_Funct Ξ± π π
β cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ = π"
if "π : π β¦βcat_Funct Ξ± π π
β β" for π β π
proof-
note π = cat_Funct_is_arrD[OF that]
from assms π(1) show
"π ββ©Aβcat_Funct Ξ± π π
β cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ = π"
by (subst (1 2) π(2), use nothing in βΉsubst π(3)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
qed
qed auto
qed
lemma category_cat_Funct'[cat_FUNCT_cs_intros]:
assumes "tiny_category Ξ± π"
and "category Ξ± π
"
and "Ξ² = Ξ±"
shows "category Ξ± (cat_Funct Ξ² π π
)"
using assms(1,2) unfolding assms(3) by (rule category_cat_Funct)
subsubsectionβΉβΉFunctβΊ is a subcategory of βΉFUNCTβΊβΊ
lemma subcategory_cat_Funct_cat_FUNCT:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "tiny_category Ξ± π" and "category Ξ± π
"
shows "cat_Funct Ξ± π π
ββ©CβΞ²β cat_FUNCT Ξ± π π
"
proof
(
intro subcategoryI,
unfold cat_smc_FUNCT cat_smc_Funct cat_Funct_components(1)
)
interpret category Ξ± π
by (rule assms(4))
interpret ππ
: category Ξ± βΉcat_Funct Ξ± π π
βΊ
by (rule category_cat_Funct[OF assms(3,4)])
show "category Ξ² (cat_Funct Ξ± π π
)"
by (rule category.cat_category_if_ge_Limit[OF _ assms(1,2)])
(auto intro: cat_cs_intros)
from assms show "category Ξ² (cat_FUNCT Ξ± π π
)"
by (cs_concl cs_intro: tiny_category_cat_FUNCT cat_small_cs_intros)
show "smc_Funct Ξ± π π
ββ©Sβ©Mβ©CβΞ²β smc_FUNCT Ξ± π π
"
by (rule subsemicategory_smc_Funct_smc_FUNCT[OF assms])
show "cat_Funct Ξ± π π
β¦CIdβ¦β¦πβ¦ = cat_FUNCT Ξ± π π
β¦CIdβ¦β¦πβ¦"
if βΉπ ββ©β tm_cf_maps Ξ± π π
βΊ for π
proof-
from that obtain π' where π_def: "π = cf_map π'"
and π': "π' : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by auto
from that show ?thesis
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros tm_cf_maps_in_cf_maps
)
qed
qed
subsubsectionβΉIsomorphismβΊ
lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI:
assumes "category Ξ± π
"
shows "ntcf_arrow π : cf_map π β¦β©iβ©sβ©oβcat_Funct Ξ± π π
β cf_map π"
proof(intro is_arr_isomorphismI is_inverseI)
from is_tm_iso_ntcf_axioms show
"ntcf_arrow π : cf_map π β¦βcat_Funct Ξ± π π
β cf_map π"
by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
interpret inv_π: is_tm_iso_ntcf Ξ± π π
π π βΉinv_ntcf πβΊ
by (rule iso_tm_ntcf_is_arr_isomorphism(1)[OF assms is_tm_iso_ntcf_axioms])
from inv_π.is_tm_iso_ntcf_axioms show
"ntcf_arrow (inv_ntcf π) : cf_map π β¦βcat_Funct Ξ± π π
β cf_map π"
by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
from is_tm_iso_ntcf_axioms show
"ntcf_arrow π : cf_map π β¦βcat_Funct Ξ± π π
β cf_map π"
by (cs_concl cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros)
from assms is_tm_iso_ntcf_axioms show
"ntcf_arrow (inv_ntcf π) ββ©Aβcat_Funct Ξ± π π
β ntcf_arrow π =
cat_Funct Ξ± π π
β¦CIdβ¦β¦cf_map πβ¦"
"ntcf_arrow π ββ©Aβcat_Funct Ξ± π π
β ntcf_arrow (inv_ntcf π) =
cat_Funct Ξ± π π
β¦CIdβ¦β¦cf_map πβ¦"
by
(
cs_concl
cs_simp: iso_tm_ntcf_is_arr_isomorphism(2,3) cat_FUNCT_cs_simps
cs_intro: ntcf_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)+
qed
lemma (in is_tm_iso_ntcf) cat_Funct_is_arr_isomorphismI':
assumes "category Ξ± π
"
and "π' = ntcf_arrow π"
and "π' = cf_map π"
and "π' = cf_map π"
shows "π' : π' β¦β©iβ©sβ©oβcat_Funct Ξ± π π
β cf_map π"
using assms(1) unfolding assms(2-4) by (rule cat_Funct_is_arr_isomorphismI)
lemmas [cat_FUNCT_cs_intros] =
is_tm_iso_ntcf.cat_Funct_is_arr_isomorphismI'[rotated 2]
lemma (in π΅) cat_Funct_is_arr_isomorphismD:
assumes "tiny_category Ξ± π"
and "category Ξ± π
"
and "π : π β¦β©iβ©sβ©oβcat_Funct Ξ± π π
β π" (is βΉπ : π β¦β©iβ©sβ©oβ?Functβ πβΊ)
shows "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o cf_of_cf_map π π
π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
and "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
proof-
interpret Funct: category Ξ± ?Funct
by (rule category_cat_Funct[OF assms(1,2)])
have inv_π: "πΒ―β©Cβ?Functβ : π β¦β©iβ©sβ©oβ?Functβ π"
and inv_π_π: "πΒ―β©Cβ?Functβ ββ©Aβ?Functβ π = ?Functβ¦CIdβ¦β¦πβ¦"
and π_inv_π: "π ββ©Aβ?Functβ πΒ―β©Cβ?Functβ = ?Functβ¦CIdβ¦β¦πβ¦"
by
(
intro
Funct.cat_the_inverse_is_arr_isomorphism[OF assms(3)]
Funct.cat_the_inverse_Comp_CId[OF assms(3)]
)+
from assms is_arr_isomorphismD inv_π
have π_is_arr: "π : π β¦βcat_Funct Ξ± π π
β π"
and inv_π_is_arr: "πΒ―β©Cβ?Functβ : π β¦βcat_Funct Ξ± π π
β π"
by auto
note π_is_arr = cat_Funct_is_arrD[OF π_is_arr]
note inv_π_is_arr = cat_Funct_is_arrD[OF inv_π_is_arr]
let ?π = βΉntcf_of_ntcf_arrow π π
πβΊ
and ?inv_π = βΉntcf_of_ntcf_arrow π π
(πΒ―β©Cβcat_Funct Ξ± π π
β)βΊ
from inv_π_π π_is_arr(1) inv_π_is_arr(1) have inv_π_π:
"?inv_π ββ©Nβ©Tβ©Cβ©F ?π = ntcf_id (cf_of_cf_map π π
π)"
by
(
subst (asm) inv_π_is_arr(2),
use nothing in βΉsubst (asm) (2) π_is_arr(2), subst (asm) π_is_arr(3)βΊ
)
(
cs_prems
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
from π_inv_π inv_π_is_arr(1) π_is_arr(1) have π_inv_π:
"?π ββ©Nβ©Tβ©Cβ©F ?inv_π = ntcf_id (cf_of_cf_map π π
π)"
by
(
subst (asm) inv_π_is_arr(2),
use nothing in βΉsubst (asm) π_is_arr(2), subst (asm) π_is_arr(4)βΊ
)
(
cs_prems
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros
)
show "ntcf_of_ntcf_arrow π π
π :
cf_of_cf_map π π
π β¦β©Cβ©Fβ©.β©tβ©mβ©.β©iβ©sβ©o cf_of_cf_map π π
π : π β¦β¦β©Cβ©.β©tβ©mβΞ±β π
"
by
(
rule is_arr_isomorphism_is_tm_iso_ntcf[
OF π_is_arr(1) inv_π_is_arr(1) π_inv_π inv_π_π
]
)
show "π = ntcf_arrow (ntcf_of_ntcf_arrow π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
and "π = cf_map (cf_of_cf_map π π
π)"
by (intro π_is_arr(2-4))+
qed
subsectionβΉDiagonal functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-3 in \cite{mac_lane_categories_2010}.βΊ
definition cf_diagonal :: "V β V β V β V" (βΉΞβ©CβΊ)
where "Ξβ©C Ξ± π β =
[
(Ξ»aββ©βββ¦Objβ¦. cf_map (cf_const π β a)),
(Ξ»fββ©βββ¦Arrβ¦. ntcf_arrow (ntcf_const π β f)),
β,
cat_Funct Ξ± π β
]β©β"
textβΉComponents.βΊ
lemma cf_diagonal_components:
shows "Ξβ©C Ξ± π ββ¦ObjMapβ¦ = (Ξ»aββ©βββ¦Objβ¦. cf_map (cf_const π β a))"
and "Ξβ©C Ξ± π ββ¦ArrMapβ¦ = (Ξ»fββ©βββ¦Arrβ¦. ntcf_arrow (ntcf_const π β f))"
and "Ξβ©C Ξ± π ββ¦HomDomβ¦ = β"
and "Ξβ©C Ξ± π ββ¦HomCodβ¦ = cat_Funct Ξ± π β"
unfolding cf_diagonal_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda cf_diagonal_components(1)
|vsv cf_diagonal_ObjMap_vsv[cat_cs_intros]|
|vdomain cf_diagonal_ObjMap_vdomain[cat_cs_simps]|
|app cf_diagonal_ObjMap_app[cat_cs_simps]|
lemma cf_diagonal_ObjMap_vrange:
assumes "tiny_category Ξ± π" and "category Ξ± β"
shows "ββ©β (Ξβ©C Ξ± π ββ¦ObjMapβ¦) ββ©β cat_Funct Ξ± π ββ¦Objβ¦"
unfolding cf_diagonal_components
proof(rule vrange_VLambda_vsubset)
fix x assume "x ββ©β ββ¦Objβ¦"
with assms category_cat_Funct[OF assms] show
"cf_map (cf_const π β x) ββ©β cat_Funct Ξ± π ββ¦Objβ¦"
unfolding cat_Funct_components(1)
by (cs_concl cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_diagonal_components(2)
|vsv cf_diagonal_ArrMap_vsv[cat_cs_intros]|
|vdomain cf_diagonal_ArrMap_vdomain[cat_cs_simps]|
|app cf_diagonal_ArrMap_app[cat_cs_simps]|
subsubsectionβΉDiagonal functor is a functorβΊ
lemma cf_diagonal_is_functor[cat_cs_intros]:
assumes "tiny_category Ξ± π" and "category Ξ± β"
shows "Ξβ©C Ξ± π β : β β¦β¦β©CβΞ±β cat_Funct Ξ± π β" (is βΉ?Ξ : β β¦β¦β©CβΞ±β ?FunctβΊ)
proof-
interpret π: tiny_category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
show ?thesis
proof(intro is_functorI')
show "vfsequence ?Ξ"
unfolding cf_diagonal_def by (simp add: nat_omega_simps)
from assms(2) show "category Ξ± β"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "category Ξ± ?Funct"
by (cs_concl cs_intro: cat_cs_intros category_cat_Funct)
show "vcard ?Ξ = 4β©β"
unfolding cf_diagonal_def by (simp add: nat_omega_simps)
show "vsv (?Ξβ¦ObjMapβ¦)" unfolding cf_diagonal_components by simp
from assms show "ββ©β (?Ξβ¦ObjMapβ¦) ββ©β ?Functβ¦Objβ¦"
by (rule cf_diagonal_ObjMap_vrange)
show "?Ξβ¦ArrMapβ¦β¦fβ¦ : ?Ξβ¦ObjMapβ¦β¦aβ¦ β¦β?Functβ ?Ξβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βββ b" for f a b
using that
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
show "?Ξβ¦ArrMapβ¦β¦g ββ©Aβββ fβ¦ = ?Ξβ¦ArrMapβ¦β¦gβ¦ ββ©Aβ?Functβ ?Ξβ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βββ c" and "f : a β¦βββ b" for g b c f a
using that π.category_axioms β.category_axioms
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
fix c assume "c ββ©β ββ¦Objβ¦"
with π.category_axioms β.category_axioms show
"?Ξβ¦ArrMapβ¦β¦ββ¦CIdβ¦β¦cβ¦β¦ = ?Functβ¦CIdβ¦β¦?Ξβ¦ObjMapβ¦β¦cβ¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (auto simp: cf_diagonal_components cat_smc_FUNCT)
qed
lemma cf_diagonal_is_functor'[cat_cs_intros]:
assumes "tiny_category Ξ± π"
and "category Ξ± β"
and "Ξ±' = Ξ±"
and "π = β"
and "π
= cat_Funct Ξ± π β"
shows "Ξβ©C Ξ± π β : π β¦β¦β©CβΞ±'β π
"
using assms(1-2) unfolding assms(3-5) by (rule cf_diagonal_is_functor)
subsectionβΉFunctor raised to the power of a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
Most of the definitions and the results presented in this
and the remaining subsections
can be found in \cite{mac_lane_categories_2010} and
\cite{riehl_category_2016} (e.g., see Chapter X-3
in \cite{mac_lane_categories_2010}).
βΊ
definition exp_cf_cat :: "V β V β V β V"
where "exp_cf_cat Ξ± π π =
[
(
Ξ»πββ©βcat_FUNCT Ξ± π (πβ¦HomDomβ¦)β¦Objβ¦.
cf_map (π ββ©Cβ©F cf_of_cf_map π (πβ¦HomDomβ¦) π)
),
(
Ξ»Οββ©βcat_FUNCT Ξ± π (πβ¦HomDomβ¦)β¦Arrβ¦.
ntcf_arrow (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ntcf_of_ntcf_arrow π (πβ¦HomDomβ¦) Ο)
),
cat_FUNCT Ξ± π (πβ¦HomDomβ¦),
cat_FUNCT Ξ± π (πβ¦HomCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma exp_cf_cat_components:
shows "exp_cf_cat Ξ± π πβ¦ObjMapβ¦ =
(
Ξ»πββ©βcat_FUNCT Ξ± π (πβ¦HomDomβ¦)β¦Objβ¦.
cf_map (π ββ©Cβ©F cf_of_cf_map π (πβ¦HomDomβ¦) π)
)"
and
"exp_cf_cat Ξ± π πβ¦ArrMapβ¦ =
(
Ξ»Οββ©βcat_FUNCT Ξ± π (πβ¦HomDomβ¦)β¦Arrβ¦.
ntcf_arrow (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F (ntcf_of_ntcf_arrow π (πβ¦HomDomβ¦) Ο))
)"
and "exp_cf_cat Ξ± π πβ¦HomDomβ¦ = cat_FUNCT Ξ± π (πβ¦HomDomβ¦)"
and "exp_cf_cat Ξ± π πβ¦HomCodβ¦ = cat_FUNCT Ξ± π (πβ¦HomCodβ¦)"
unfolding exp_cf_cat_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda exp_cf_cat_components(1)
|vsv exp_cf_cat_components_ObjMap_vsv[cat_FUNCT_cs_intros]|
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda exp_cf_cat_components(1)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
|vdomain exp_cf_cat_components_ObjMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_cf_cat_components_ObjMap_app[cat_FUNCT_cs_simps]|
end
subsubsectionβΉArrow mapβΊ
mk_VLambda exp_cf_cat_components(2)
|vsv exp_cf_cat_components_ArrMap_vsv[cat_FUNCT_cs_intros]|
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda exp_cf_cat_components(2)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
|vdomain exp_cf_cat_components_ArrMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_cf_cat_components_ArrMap_app[cat_FUNCT_cs_simps]|
end
subsubsectionβΉDomain and codomainβΊ
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
lemmas exp_cf_cat_HomDom[cat_FUNCT_cs_simps] =
exp_cf_cat_components(3)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
and exp_cf_cat_HomCod[cat_FUNCT_cs_simps] =
exp_cf_cat_components(4)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
end
subsubsectionβΉFunctor raised to the power of a category is a functorβΊ
lemma exp_cf_cat_is_tiny_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "exp_cf_cat Ξ± π π : cat_FUNCT Ξ± π π
β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π β"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: category Ξ± π by (rule assms(3))
interpret π: is_functor Ξ± π
β π by (rule assms(4))
from assms(2-4) interpret ππ
: tiny_category Ξ² βΉcat_FUNCT Ξ± π π
βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2-4) interpret πβ: tiny_category Ξ² βΉcat_FUNCT Ξ± π ββΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
show ?thesis
proof(intro is_tiny_functorI' is_functorI')
show "vfsequence (exp_cf_cat Ξ± π π)" unfolding exp_cf_cat_def by simp
show "vcard (exp_cf_cat Ξ± π π) = 4β©β"
unfolding exp_cf_cat_def by (simp add: nat_omega_simps)
show "ββ©β (exp_cf_cat Ξ± π πβ¦ObjMapβ¦) ββ©β cat_FUNCT Ξ± π ββ¦Objβ¦"
proof
(
unfold cat_FUNCT_components exp_cf_cat_components,
intro vrange_VLambda_vsubset,
unfold cat_cs_simps
)
fix π assume "π ββ©β cf_maps Ξ± π π
"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π
"
by auto
from assms(2-4) π' show
"cf_map (π ββ©Cβ©F cf_of_cf_map π π
π) ββ©β cf_maps Ξ± π β"
by (cs_concl cs_simp: π_def cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
show "exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦πβ¦ :
exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦πβ¦ β¦βcat_FUNCT Ξ± π ββ
exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± π π
β π" for π π π
proof-
note π = cat_FUNCT_is_arrD[OF that]
from π(1,3,4) assms(2-4) show ?thesis
by (subst π(2), use nothing in βΉsubst π(3), subst π(4)βΊ)
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦π ββ©Aβcat_FUNCT Ξ± π π
β πβ¦ =
exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π ββ
exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± π π
β β" and "π : π β¦βcat_FUNCT Ξ± π π
β π"
for π β π π π
proof-
note π = cat_FUNCT_is_arrD[OF that(1)]
and π = cat_FUNCT_is_arrD[OF that(2)]
from π(1,3,4) π(1,3,4) assms(2-4) show ?thesis
by (subst (1 2) π(2), use nothing in βΉsubst (1 2) π(2)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦cat_FUNCT Ξ± π π
β¦CIdβ¦β¦πβ¦β¦ =
cat_FUNCT Ξ± π ββ¦CIdβ¦β¦exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦πβ¦β¦"
if "π ββ©β cat_FUNCT Ξ± π π
β¦Objβ¦" for π
proof-
from that[unfolded cat_FUNCT_components] obtain π
where π_def: "π = cf_map π" and π: "π : π β¦β¦β©CβΞ±β π
"
by auto
from π show
"exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦cat_FUNCT Ξ± π π
β¦CIdβ¦β¦πβ¦β¦ =
cat_FUNCT Ξ± π ββ¦CIdβ¦β¦exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦πβ¦β¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps π_def
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed
(
use assms(1,2) in
βΉ
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
βΊ
)+
qed
lemma exp_cf_cat_is_tiny_functor'[cat_FUNCT_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "category Ξ± π"
and "π : π
β¦β¦β©CβΞ±β β"
and "π' = cat_FUNCT Ξ± π π
"
and "π
' = cat_FUNCT Ξ± π β"
shows "exp_cf_cat Ξ± π π : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
'"
using assms(1-4) unfolding assms(5,6) by (rule exp_cf_cat_is_tiny_functor)
subsubsectionβΉFurther propertiesβΊ
lemma exp_cf_cat_cf_comp:
assumes "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β" and "π : π β¦β¦β©CβΞ±β π
"
shows "exp_cf_cat Ξ± (π ββ©Cβ©F π) π = exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π"
proof(rule cf_eqI)
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_functor Ξ± π π
π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
from Ξ±Ξ² show
"exp_cf_cat Ξ± (π ββ©Cβ©F π) π : cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show
"exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ObjMapβ¦) = cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦) =
cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ObjMapβ¦ =
(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "vsv (exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ObjMapβ¦)"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
from Ξ±Ξ² show "vsv ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦)"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
fix β assume "β ββ©β cat_FUNCT Ξ± π πβ¦Objβ¦"
then have "β ββ©β cf_maps Ξ± π π" unfolding cat_FUNCT_components by simp
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β π"
by auto
from assms Ξ±Ξ² β' show
"exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ObjMapβ¦β¦ββ¦ =
(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦β¦ββ¦"
by (subst (1 2) β_def)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed simp
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ArrMapβ¦) = cat_FUNCT Ξ± π πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦) =
cat_FUNCT Ξ± π πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ArrMapβ¦ =
(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "vsv (exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ArrMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
from Ξ±Ξ² show "vsv ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦)"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
fix π assume "π ββ©β cat_FUNCT Ξ± π πβ¦Arrβ¦"
then obtain β β' where π: "π : β β¦βcat_FUNCT Ξ± π πβ β'"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from Ξ±Ξ² assms π(1,3,4) show
"exp_cf_cat Ξ± (π ββ©Cβ©F π) πβ¦ArrMapβ¦β¦πβ¦ =
(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cf_comp_cf_ntcf_comp_assoc
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed simp
qed simp_all
lemma exp_cf_cat_cf_id_cat:
assumes "category Ξ± β" and "category Ξ± π"
shows "exp_cf_cat Ξ± (cf_id β) π = cf_id (cat_FUNCT Ξ± π β)"
proof(rule cf_eqI)
interpret β: category Ξ± β by (rule assms)
interpret π: category Ξ± π by (rule assms)
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def β.π΅_Limit_Ξ±Ο β.π΅_Ο_Ξ±Ο π΅_def β.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
from Ξ±Ξ² show
"cf_id (cat_FUNCT Ξ± π β) : cat_FUNCT Ξ± π β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show
"exp_cf_cat Ξ± (cf_id β) π : cat_FUNCT Ξ± π β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have ObjMap_dom_lhs:
"πβ©β (exp_cf_cat Ξ± (cf_id β) πβ¦ObjMapβ¦) = cat_FUNCT Ξ± π ββ¦Objβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
from Ξ±Ξ² have ObjMap_dom_rhs:
"πβ©β (cf_id (cat_FUNCT Ξ± π β)β¦ObjMapβ¦) = cat_FUNCT Ξ± π ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show "exp_cf_cat Ξ± (cf_id β) πβ¦ObjMapβ¦ = cf_id (cat_FUNCT Ξ± π β)β¦ObjMapβ¦"
proof
(
rule vsv_eqI,
unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
)
fix β assume prems: "β ββ©β cf_maps Ξ± π β"
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β β"
by clarsimp
from prems β' show
"exp_cf_cat Ξ± (cf_id β) πβ¦ObjMapβ¦β¦ββ¦ = cf_id (cat_FUNCT Ξ± π β)β¦ObjMapβ¦β¦ββ¦"
by (subst (1 2) β_def)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
from Ξ±Ξ² have ArrMap_dom_lhs:
"πβ©β (cf_id (cat_FUNCT Ξ± π β)β¦ArrMapβ¦) = cat_FUNCT Ξ± π ββ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from Ξ±Ξ² have ArrMap_dom_rhs:
"πβ©β (exp_cf_cat Ξ± (cf_id β) πβ¦ArrMapβ¦) = cat_FUNCT Ξ± π ββ¦Arrβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
show "exp_cf_cat Ξ± (cf_id β) πβ¦ArrMapβ¦ = cf_id (cat_FUNCT Ξ± π β)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix π assume "π ββ©β cat_FUNCT Ξ± π ββ¦Arrβ¦"
then obtain π π where π: "π : π β¦βcat_FUNCT Ξ± π ββ π"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from π(1,3,4) Ξ±Ξ² show
"exp_cf_cat Ξ± (cf_id β) πβ¦ArrMapβ¦β¦πβ¦ =
cf_id (cat_FUNCT Ξ± π β)β¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed simp_all
lemma cf_comp_exp_cf_cat_exp_cf_cat_cf_id[cat_FUNCT_cs_simps]:
assumes "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π = exp_cf_cat Ξ± π π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule cf_eqI)
from assms Ξ±Ξ² Ξ² show ππ:
"exp_cf_cat Ξ± π π : cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by (cs_concl cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
with assms Ξ±Ξ² show
"exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms Ξ±Ξ² have ObjMap_dom_lhs:
"πβ©β ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ObjMapβ¦) =
cat_FUNCT Ξ± π π
β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms have ObjMap_dom_rhs:
"πβ©β (exp_cf_cat Ξ± π πβ¦ObjMapβ¦) = cat_FUNCT Ξ± π π
β¦Objβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
from assms Ξ±Ξ² have ArrMap_dom_lhs:
"πβ©β ((exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ArrMapβ¦) =
cat_FUNCT Ξ± π π
β¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms have ArrMap_dom_rhs:
"πβ©β (exp_cf_cat Ξ± π πβ¦ArrMapβ¦) = cat_FUNCT Ξ± π π
β¦Arrβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
show
"(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ObjMapβ¦ =
exp_cf_cat Ξ± π πβ¦ObjMapβ¦"
proof
(
rule vsv_eqI,
unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
)
fix β assume prems: "β ββ©β cf_maps Ξ± π π
"
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β π
"
by clarsimp
from prems β' assms ππ Ξ±Ξ² show
"(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ObjMapβ¦β¦ββ¦ =
exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦ββ¦"
unfolding β_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
)
qed
(
use assms ππ Ξ±Ξ² in
βΉ
cs_concl
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
βΊ
)
show
"(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ArrMapβ¦ =
exp_cf_cat Ξ± π πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix π assume "π ββ©β cat_FUNCT Ξ± π π
β¦Arrβ¦"
then obtain π' π' where π: "π : π' β¦βcat_FUNCT Ξ± π π
β π'"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from π(1) assms ππ Ξ±Ξ² show
"(exp_cf_cat Ξ± π π ββ©Cβ©F exp_cf_cat Ξ± (cf_id π
) π)β¦ArrMapβ¦β¦πβ¦ =
exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
)
qed
(
use assms Ξ±Ξ² in
βΉ
cs_concl cs_intro:
cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
βΊ
)
qed simp_all
qed
lemma cf_comp_exp_cf_cat_cf_id_exp_cf_cat[cat_FUNCT_cs_simps]:
assumes "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π = exp_cf_cat Ξ± π π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule cf_eqI)
from assms Ξ±Ξ² Ξ² show ππ:
"exp_cf_cat Ξ± π π : cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros)
with assms Ξ±Ξ² show
"exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms Ξ±Ξ² have ObjMap_dom_lhs:
"πβ©β ((exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦) =
cat_FUNCT Ξ± π π
β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms have ObjMap_dom_rhs:
"πβ©β (exp_cf_cat Ξ± π πβ¦ObjMapβ¦) = cat_FUNCT Ξ± π π
β¦Objβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
from assms Ξ±Ξ² have ArrMap_dom_lhs:
"πβ©β ((exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦) =
cat_FUNCT Ξ± π π
β¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms have ArrMap_dom_rhs:
"πβ©β (exp_cf_cat Ξ± π πβ¦ArrMapβ¦) = cat_FUNCT Ξ± π π
β¦Arrβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
show
"(exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦ =
exp_cf_cat Ξ± π πβ¦ObjMapβ¦"
proof
(
rule vsv_eqI,
unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
)
fix β assume prems: "β ββ©β cf_maps Ξ± π π
"
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β π
"
by clarsimp
from prems β' assms Ξ±Ξ² ππ show
"(exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ObjMapβ¦β¦ββ¦ =
exp_cf_cat Ξ± π πβ¦ObjMapβ¦β¦ββ¦"
unfolding β_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
)
qed
(
use assms Ξ±Ξ² ππ in
βΉ
cs_concl
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
βΊ
)
show
"(exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦ =
exp_cf_cat Ξ± π πβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix π assume "π ββ©β cat_FUNCT Ξ± π π
β¦Arrβ¦"
then obtain π' π' where π: "π : π' β¦βcat_FUNCT Ξ± π π
β π'"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from π(1) assms Ξ±Ξ² ππ show
"(exp_cf_cat Ξ± (cf_id β) π ββ©Cβ©F exp_cf_cat Ξ± π π)β¦ArrMapβ¦β¦πβ¦ =
exp_cf_cat Ξ± π πβ¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
)
qed
(
use assms Ξ±Ξ² in
βΉ
cs_concl
cs_intro: cat_FUNCT_cs_intros cat_small_cs_intros cat_cs_intros
βΊ
)
qed simp_all
qed
subsectionβΉCategory raised to the power of a functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition exp_cat_cf :: "V β V β V β V"
where "exp_cat_cf Ξ± π π =
[
(
Ξ»πββ©βcat_FUNCT Ξ± (πβ¦HomCodβ¦) πβ¦Objβ¦.
cf_map (cf_of_cf_map (πβ¦HomCodβ¦) π π ββ©Cβ©F π)
),
(
Ξ»Οββ©βcat_FUNCT Ξ± (πβ¦HomCodβ¦) πβ¦Arrβ¦.
ntcf_arrow (ntcf_of_ntcf_arrow (πβ¦HomCodβ¦) π Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
),
cat_FUNCT Ξ± (πβ¦HomCodβ¦) π,
cat_FUNCT Ξ± (πβ¦HomDomβ¦) π
]β©β"
textβΉComponents.βΊ
lemma exp_cat_cf_components:
shows "exp_cat_cf Ξ± π πβ¦ObjMapβ¦ =
(
Ξ»πββ©βcat_FUNCT Ξ± (πβ¦HomCodβ¦) πβ¦Objβ¦.
cf_map (cf_of_cf_map (πβ¦HomCodβ¦) π π ββ©Cβ©F π)
)"
and "exp_cat_cf Ξ± π πβ¦ArrMapβ¦ =
(
Ξ»Οββ©βcat_FUNCT Ξ± (πβ¦HomCodβ¦) πβ¦Arrβ¦.
ntcf_arrow (ntcf_of_ntcf_arrow (πβ¦HomCodβ¦) π Ο ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
)"
and "exp_cat_cf Ξ± π πβ¦HomDomβ¦ = cat_FUNCT Ξ± (πβ¦HomCodβ¦) π"
and "exp_cat_cf Ξ± π πβ¦HomCodβ¦ = cat_FUNCT Ξ± (πβ¦HomDomβ¦) π"
unfolding exp_cat_cf_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda exp_cat_cf_components(1)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
|vsv exp_cat_cf_components_ObjMap_vsv[cat_FUNCT_cs_intros]|
|vdomain exp_cat_cf_components_ObjMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_cat_cf_components_ObjMap_app[cat_FUNCT_cs_simps]|
end
subsubsectionβΉArrow mapβΊ
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda exp_cat_cf_components(2)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
|vsv exp_cat_cf_components_ArrMap_vsv[cat_FUNCT_cs_intros]|
|vdomain exp_cat_cf_components_ArrMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_cat_cf_components_ArrMap_app[cat_FUNCT_cs_simps]|
end
subsubsectionβΉDomain and codomainβΊ
context
fixes Ξ± π π
β
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
lemmas exp_cat_cf_HomDom[cat_FUNCT_cs_simps] =
exp_cat_cf_components(3)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
and exp_cat_cf_HomCod[cat_FUNCT_cs_simps] =
exp_cat_cf_components(4)[where π=π and Ξ±=Ξ±, unfolded cat_cs_simps]
end
subsubsectionβΉCategory raised to the power of a functor is a functorβΊ
lemma exp_cat_cf_is_tiny_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²" and "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "exp_cat_cf Ξ± π π : cat_FUNCT Ξ± β π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π
π"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: category Ξ± π by (rule assms(3))
interpret π: is_functor Ξ± π
β π by (rule assms(4))
from assms(2-4) interpret βπ: tiny_category Ξ² βΉcat_FUNCT Ξ± β πβΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2-4) interpret π
π: tiny_category Ξ² βΉcat_FUNCT Ξ± π
πβΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
show ?thesis
proof(intro is_tiny_functorI' is_functorI')
show "vfsequence (exp_cat_cf Ξ± π π)" unfolding exp_cat_cf_def by auto
show "vcard (exp_cat_cf Ξ± π π) = 4β©β"
unfolding exp_cat_cf_def by (simp_all add: nat_omega_simps)
show "ββ©β (exp_cat_cf Ξ± π πβ¦ObjMapβ¦) ββ©β cat_FUNCT Ξ± π
πβ¦Objβ¦"
proof
(
unfold cat_FUNCT_components exp_cat_cf_components,
intro vrange_VLambda_vsubset,
unfold cat_cs_simps
)
fix π assume "π ββ©β cf_maps Ξ± β π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by auto
from assms(2-4) π' show
"cf_map (cf_of_cf_map β π π ββ©Cβ©F π) ββ©β cf_maps Ξ± π
π"
unfolding π_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show "exp_cat_cf Ξ± π πβ¦ArrMapβ¦β¦πβ¦ :
exp_cat_cf Ξ± π πβ¦ObjMapβ¦β¦πβ¦ β¦βcat_FUNCT Ξ± π
πβ
exp_cat_cf Ξ± π πβ¦ObjMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± β πβ π" for π π π
proof-
note π = cat_FUNCT_is_arrD[OF that]
from π(1) assms(2-4) show ?thesis
by (subst π(2), use nothing in βΉsubst π(3), subst π(4)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"exp_cat_cf Ξ± π πβ¦ArrMapβ¦β¦π ββ©Aβcat_FUNCT Ξ± β πβ πβ¦ =
exp_cat_cf Ξ± π πβ¦ArrMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π
πβ
exp_cat_cf Ξ± π πβ¦ArrMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± β πβ β" and "π : π β¦βcat_FUNCT Ξ± β πβ π"
for π β π π π
proof-
note π = cat_FUNCT_is_arrD[OF that(1)]
and π = cat_FUNCT_is_arrD[OF that(2)]
from π(1) π(1) assms(2-4) show ?thesis
by (subst (1 2) π(2), use nothing in βΉsubst (1 2) π(2)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"exp_cat_cf Ξ± π πβ¦ArrMapβ¦β¦cat_FUNCT Ξ± β πβ¦CIdβ¦β¦πβ¦β¦ =
cat_FUNCT Ξ± π
πβ¦CIdβ¦β¦exp_cat_cf Ξ± π πβ¦ObjMapβ¦β¦πβ¦β¦"
if "π ββ©β cat_FUNCT Ξ± β πβ¦Objβ¦" for π
proof-
from that have π: "π ββ©β cf_maps Ξ± β π"
unfolding cat_FUNCT_components by simp
then obtain π' where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by auto
from assms(2-4) π π' show ?thesis
by
(
cs_concl
cs_simp:
cat_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) π_def
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
)+
qed
lemma exp_cat_cf_is_tiny_functor'[cat_FUNCT_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "category Ξ± π"
and "π : π
β¦β¦β©CβΞ±β β"
and "π' = cat_FUNCT Ξ± β π"
and "π
' = cat_FUNCT Ξ± π
π"
shows "exp_cat_cf Ξ± π π : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
'"
using assms(1-4) unfolding assms(5,6) by (rule exp_cat_cf_is_tiny_functor)
subsubsectionβΉFurther propertiesβΊ
lemma exp_cat_cf_cat_cf_id:
assumes "category Ξ± π" and "category Ξ± β"
shows "exp_cat_cf Ξ± π (cf_id β) = cf_id (cat_FUNCT Ξ± β π)"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret β: category Ξ± β by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule cf_eqI)
from Ξ±Ξ² show "exp_cat_cf Ξ± π (cf_id β) :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± β π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show
"cf_id (cat_FUNCT Ξ± β π) : cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± β π"
by
(
cs_concl
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have ObjMap_dom_lhs:
"πβ©β (exp_cat_cf Ξ± π (cf_id β)β¦ObjMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have ObjMap_dom_rhs:
"πβ©β (cf_id (cat_FUNCT Ξ± β π)β¦ObjMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
)
show "exp_cat_cf Ξ± π (cf_id β)β¦ObjMapβ¦ = cf_id (cat_FUNCT Ξ± β π)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1))
fix π assume "π ββ©β cf_maps Ξ± β π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by clarsimp
from π' show
"exp_cat_cf Ξ± π (cf_id β)β¦ObjMapβ¦β¦πβ¦ =
cf_id (cat_FUNCT Ξ± β π)β¦ObjMapβ¦β¦πβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps π_def
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
from Ξ±Ξ² have ArrMap_dom_lhs:
"πβ©β (exp_cat_cf Ξ± π (cf_id β)β¦ArrMapβ¦) = cat_FUNCT Ξ± β πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have ArrMap_dom_rhs:
"πβ©β (cf_id (cat_FUNCT Ξ± β π)β¦ArrMapβ¦) = cat_FUNCT Ξ± β πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
)
show "exp_cat_cf Ξ± π (cf_id β)β¦ArrMapβ¦ = cf_id (cat_FUNCT Ξ± β π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix π assume "π ββ©β cat_FUNCT Ξ± β πβ¦Arrβ¦"
then obtain β β' where π: "π : β β¦βcat_FUNCT Ξ± β πβ β'"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from π(1) show
"exp_cat_cf Ξ± π (cf_id β)β¦ArrMapβ¦β¦πβ¦ =
cf_id (cat_FUNCT Ξ± β π)β¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
qed simp_all
qed
lemma exp_cat_cf_cf_comp:
assumes "category Ξ± π" and "π : β β¦β¦β©CβΞ±β π" and "π : π
β¦β¦β©CβΞ±β β"
shows "exp_cat_cf Ξ± π (π ββ©Cβ©F π) = exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± β π π by (rule assms(2))
interpret π: is_functor Ξ± π
β π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule cf_eqI)
from Ξ² Ξ±Ξ² show "exp_cat_cf Ξ± π (π ββ©Cβ©F π) :
cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ² Ξ±Ξ² show "exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π :
cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ² Ξ±Ξ² have ObjMap_dom_lhs:
"πβ©β (exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ObjMapβ¦) = cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ² Ξ±Ξ² have ObjMap_dom_rhs:
"πβ©β ((exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ObjMapβ¦) =
cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ² Ξ±Ξ² have ArrMap_dom_lhs:
"πβ©β (exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ArrMapβ¦) = cat_FUNCT Ξ± π πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ² Ξ±Ξ² have ArrMap_dom_rhs:
"πβ©β ((exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ArrMapβ¦) =
cat_FUNCT Ξ± π πβ¦Arrβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ObjMapβ¦ =
(exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ObjMapβ¦"
proof
(
rule vsv_eqI,
unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_FUNCT_components(1)
)
fix β assume "β ββ©β cf_maps Ξ± π π"
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β π"
by clarsimp
from Ξ² Ξ±Ξ² β' assms show
"exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ObjMapβ¦β¦ββ¦ =
(exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ObjMapβ¦β¦ββ¦"
unfolding β_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
use Ξ² Ξ±Ξ² in
βΉ
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
βΊ
)+
show "exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ArrMapβ¦ =
(exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix π assume "π ββ©β cat_FUNCT Ξ± π πβ¦Arrβ¦"
then obtain β β' where π: "π : β β¦βcat_FUNCT Ξ± π πβ β'"
by (auto intro: is_arrI)
note π = cat_FUNCT_is_arrD[OF π]
from assms π(1) Ξ² Ξ±Ξ² show
"exp_cat_cf Ξ± π (π ββ©Cβ©F π)β¦ArrMapβ¦β¦πβ¦ =
(exp_cat_cf Ξ± π π ββ©Cβ©F exp_cat_cf Ξ± π π)β¦ArrMapβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp:
cat_FUNCT_cs_simps cat_cs_simps ntcf_cf_comp_ntcf_cf_comp_assoc
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
use Ξ² Ξ±Ξ² in
βΉ
cs_concl
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
βΊ
)+
qed simp_all
qed
subsectionβΉNatural transformation raised to the power of a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition exp_ntcf_cat :: "V β V β V β V"
where "exp_ntcf_cat Ξ± π π =
[
(
Ξ»πββ©βcat_FUNCT Ξ± π (πβ¦NTDGDomβ¦)β¦Objβ¦.
ntcf_arrow (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_of_cf_map π (πβ¦NTDGDomβ¦) π)
),
exp_cf_cat Ξ± (πβ¦NTDomβ¦) π,
exp_cf_cat Ξ± (πβ¦NTCodβ¦) π,
cat_FUNCT Ξ± π (πβ¦NTDGDomβ¦),
cat_FUNCT Ξ± π (πβ¦NTDGCodβ¦)
]β©β"
textβΉComponents.βΊ
lemma exp_ntcf_cat_components:
shows "exp_ntcf_cat Ξ± π πβ¦NTMapβ¦ =
(
Ξ»πββ©βcat_FUNCT Ξ± π (πβ¦NTDGDomβ¦)β¦Objβ¦.
ntcf_arrow (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F cf_of_cf_map π (πβ¦NTDGDomβ¦) π)
)"
and "exp_ntcf_cat Ξ± π πβ¦NTDomβ¦ = exp_cf_cat Ξ± (πβ¦NTDomβ¦) π"
and "exp_ntcf_cat Ξ± π πβ¦NTCodβ¦ = exp_cf_cat Ξ± (πβ¦NTCodβ¦) π"
and "exp_ntcf_cat Ξ± π πβ¦NTDGDomβ¦ = cat_FUNCT Ξ± π (πβ¦NTDGDomβ¦)"
and "exp_ntcf_cat Ξ± π πβ¦NTDGCodβ¦ = cat_FUNCT Ξ± π (πβ¦NTDGCodβ¦)"
unfolding exp_ntcf_cat_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda exp_ntcf_cat_components(1)
|vsv exp_ntcf_cat_components_NTMap_vsv[cat_FUNCT_cs_intros]|
context is_ntcf
begin
lemmas exp_ntcf_cat_components' =
exp_ntcf_cat_components[where Ξ±=Ξ± and π=π, unfolded cat_cs_simps]
lemmas [cat_FUNCT_cs_simps] = exp_ntcf_cat_components'(2-5)
mk_VLambda exp_ntcf_cat_components(1)[where π=π, unfolded cat_cs_simps]
|vdomain exp_ntcf_cat_components_NTMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_ntcf_cat_components_NTMap_app[cat_FUNCT_cs_simps]|
end
lemmas [cat_FUNCT_cs_simps] =
is_ntcf.exp_ntcf_cat_components'(2-5)
is_ntcf.exp_ntcf_cat_components_NTMap_vdomain
is_ntcf.exp_ntcf_cat_components_NTMap_app
subsubsectionβΉ
Natural transformation raised to the power of a category
is a natural transformation
βΊ
lemma exp_ntcf_cat_is_tiny_ntcf:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "category Ξ± π"
shows "exp_ntcf_cat Ξ± π π :
exp_cf_cat Ξ± π π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π π
"
proof(rule is_tiny_ntcfI')
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(3))
interpret π: category Ξ± π by (rule assms(4))
let ?exp_π = βΉexp_ntcf_cat Ξ± π πβΊ
let ?exp_π = βΉexp_cf_cat Ξ± π πβΊ
let ?exp_π = βΉexp_cf_cat Ξ± π πβΊ
from assms(1,2) show
"exp_cf_cat Ξ± π π : cat_FUNCT Ξ± π π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π π
"
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(1,2) show
"exp_cf_cat Ξ± π π : cat_FUNCT Ξ± π π β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π π
"
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
show "?exp_π :
?exp_π β¦β©Cβ©F ?exp_π : cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π π
"
proof(rule is_ntcfI')
show "vfsequence (?exp_π)" unfolding exp_ntcf_cat_def by auto
show "vcard (?exp_π) = 5β©β"
unfolding exp_ntcf_cat_def by (simp add: nat_omega_simps)
from assms(1,2) show "?exp_π : cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π π
"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms(1,2) show "?exp_π : cat_FUNCT Ξ± π π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π π
"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show "?exp_πβ¦NTMapβ¦β¦ββ¦ :
?exp_πβ¦ObjMapβ¦β¦ββ¦ β¦βcat_FUNCT Ξ± π π
β ?exp_πβ¦ObjMapβ¦β¦ββ¦"
if "β ββ©β cat_FUNCT Ξ± π πβ¦Objβ¦" for β
proof-
from that[unfolded cat_FUNCT_cs_simps] have "β ββ©β cf_maps Ξ± π π" by simp
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π β¦β¦β©CβΞ±β π"
by auto
from β' show ?thesis
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps β_def
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"?exp_πβ¦NTMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π π
β ?exp_πβ¦ArrMapβ¦β¦πβ¦ =
?exp_πβ¦ArrMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π π
β ?exp_πβ¦NTMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± π πβ π" for π π π
proof-
note π = cat_FUNCT_is_arrD[OF that]
let ?π = βΉcf_of_cf_map π π πβΊ
and ?π = βΉcf_of_cf_map π π πβΊ
and ?π = βΉntcf_of_ntcf_arrow π π πβΊ
have [cat_cs_simps]:
"(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) =
(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π)"
proof(rule ntcf_eqI)
from π(1) show
"(π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) :
π ββ©Cβ©F ?π β¦β©Cβ©F π ββ©Cβ©F ?π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
from π(1) show
"(π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) :
π ββ©Cβ©F ?π β¦β©Cβ©F π ββ©Cβ©F ?π : π β¦β¦β©CβΞ±β π
"
by (cs_concl cs_intro: cat_cs_intros)
from π(1) have dom_lhs:
"πβ©β (((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π))β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from π(1) have dom_rhs:
"πβ©β (((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π))β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π))β¦NTMapβ¦ =
((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π))β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix d assume "d ββ©β πβ¦Objβ¦"
with π(1) show
"((π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π))β¦NTMapβ¦β¦dβ¦ =
((π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F ?π) ββ©Nβ©Tβ©Cβ©F (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F ?π))β¦NTMapβ¦β¦dβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from π(1,3,4) that show ?thesis
by (subst (1 2) π(2), use nothing in βΉsubst π(3), subst π(4)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_ntcf_cat_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "category Ξ± π"
and "π' = exp_cf_cat Ξ± π π"
and "π' = exp_cf_cat Ξ± π π"
and "π' = cat_FUNCT Ξ± π π"
and "π
' = cat_FUNCT Ξ± π π
"
shows "exp_ntcf_cat Ξ± π π : π' β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π' : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
'"
using assms(1-4) unfolding assms(5-8) by (rule exp_ntcf_cat_is_tiny_ntcf)
subsubsectionβΉFurther propertiesβΊ
lemma exp_ntcf_cat_cf_ntcf_comp:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "β : π
β¦β¦β©CβΞ±β β"
and "category Ξ± π"
shows
"exp_ntcf_cat Ξ± (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) π =
exp_cf_cat Ξ± β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π"
proof-
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
interpret π: category Ξ± π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_ntcf_cat Ξ± (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦) = cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cf_cat Ξ± β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦) =
cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_ntcf_cat Ξ± (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦ =
(exp_cf_cat Ξ± β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume prems: "π ββ©β cf_maps Ξ± π π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π"
by (auto intro: is_arrI)
from Ξ±Ξ² prems π' show
"exp_ntcf_cat Ξ± (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦β¦πβ¦ =
(exp_cf_cat Ξ± β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦β¦πβ¦"
by
(
cs_concl
cs_simp:
cf_ntcf_comp_ntcf_cf_comp_assoc
cat_cs_simps cat_FUNCT_cs_simps
π_def
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
(
cs_concl
cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_ntcf_cat_ntcf_cf_comp:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "β : π β¦β¦β©CβΞ±β π
"
and "category Ξ± π"
shows
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) π =
exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± β π"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_functor Ξ± π π
β by (rule assms(2))
interpret π: category Ξ± π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) πβ¦NTMapβ¦) = cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± β π)β¦NTMapβ¦) =
cat_FUNCT Ξ± π πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) πβ¦NTMapβ¦ =
(exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± β π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume prems: "π ββ©β cf_maps Ξ± π π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π"
by (auto intro: is_arrI)
from Ξ±Ξ² assms prems π' show
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) πβ¦NTMapβ¦β¦πβ¦ =
(exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cf_cat Ξ± β π)β¦NTMapβ¦β¦πβ¦"
by
(
cs_concl
cs_simp:
ntcf_cf_comp_ntcf_cf_comp_assoc
cat_cs_simps cat_FUNCT_cs_simps
π_def
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
(
cs_concl
cs_simp: exp_cf_cat_cf_comp cat_cs_simps cat_FUNCT_cs_simps
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_ntcf_cat_ntcf_vcomp:
assumes "category Ξ± π"
and "π : π β¦β©Cβ©F β : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©F π) π =
exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_ntcf Ξ± π
β π β π by (rule assms(2))
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² show
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©F π) π :
exp_cf_cat Ξ± π π β¦β©Cβ©F exp_cf_cat Ξ± β π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show
"exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π :
exp_cf_cat Ξ± π π β¦β©Cβ©F exp_cf_cat Ξ± β π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_lhs:
"πβ©β ((exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦) =
cat_FUNCT Ξ± π π
β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
have dom_rhs:
"πβ©β (exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦) = cat_FUNCT Ξ± π π
β¦Objβ¦"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
show
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦ =
(exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π' assume "π' ββ©β cf_maps Ξ± π π
"
then obtain π''
where π'_def: "π' = cf_map π''" and π'': "π'' : π β¦β¦β©CβΞ±β π
"
by auto
from π'' Ξ±Ξ² show
"exp_ntcf_cat Ξ± (π ββ©Nβ©Tβ©Cβ©F π) πβ¦NTMapβ¦β¦π'β¦ =
(exp_ntcf_cat Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_ntcf_cat Ξ± π π)β¦NTMapβ¦β¦π'β¦"
unfolding π'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
qed simp_all
qed
lemma ntcf_id_exp_cf_cat:
assumes "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "ntcf_id (exp_cf_cat Ξ± π π) = exp_ntcf_cat Ξ± (ntcf_id π) π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² show "exp_ntcf_cat Ξ± (ntcf_id π) π :
exp_cf_cat Ξ± π π β¦β©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show "ntcf_id (exp_cf_cat Ξ± π π) :
exp_cf_cat Ξ± π π β¦β©Cβ©F exp_cf_cat Ξ± π π :
cat_FUNCT Ξ± π π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² assms have dom_lhs:
"πβ©β (ntcf_id (exp_cf_cat Ξ± π π)β¦NTMapβ¦) = cat_FUNCT Ξ± π π
β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² assms have dom_rhs:
"πβ©β (exp_ntcf_cat Ξ± (ntcf_id π) πβ¦NTMapβ¦) = cat_FUNCT Ξ± π π
β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
show
"ntcf_id (exp_cf_cat Ξ± π π)β¦NTMapβ¦ = exp_ntcf_cat Ξ± (ntcf_id π) πβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume "π ββ©β cf_maps Ξ± π π
"
then obtain π'
where π_def: "π = cf_map π'" and π': "π' : π β¦β¦β©CβΞ±β π
"
by auto
from π' Ξ±Ξ² show
"ntcf_id (exp_cf_cat Ξ± π π)β¦NTMapβ¦β¦πβ¦ =
exp_ntcf_cat Ξ± (ntcf_id π) πβ¦NTMapβ¦β¦πβ¦"
unfolding π_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
cs_concl
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed simp_all
qed
subsectionβΉCategory raised to the power of the natural transformationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition exp_cat_ntcf :: "V β V β V β V"
where "exp_cat_ntcf Ξ± β π =
[
(
Ξ»πββ©βcat_FUNCT Ξ± (πβ¦NTDGCodβ¦) ββ¦Objβ¦.
ntcf_arrow (cf_of_cf_map (πβ¦NTDGCodβ¦) β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)
),
exp_cat_cf Ξ± β (πβ¦NTDomβ¦),
exp_cat_cf Ξ± β (πβ¦NTCodβ¦),
cat_FUNCT Ξ± (πβ¦NTDGCodβ¦) β,
cat_FUNCT Ξ± (πβ¦NTDGDomβ¦) β
]β©β"
textβΉComponents.βΊ
lemma exp_cat_ntcf_components:
shows "exp_cat_ntcf Ξ± β πβ¦NTMapβ¦ =
(
Ξ»πββ©βcat_FUNCT Ξ± (πβ¦NTDGCodβ¦) ββ¦Objβ¦.
ntcf_arrow (cf_of_cf_map (πβ¦NTDGCodβ¦) β π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)
)"
and "exp_cat_ntcf Ξ± β πβ¦NTDomβ¦ = exp_cat_cf Ξ± β (πβ¦NTDomβ¦)"
and "exp_cat_ntcf Ξ± β πβ¦NTCodβ¦ = exp_cat_cf Ξ± β (πβ¦NTCodβ¦)"
and "exp_cat_ntcf Ξ± β πβ¦NTDGDomβ¦ = cat_FUNCT Ξ± (πβ¦NTDGCodβ¦) β"
and "exp_cat_ntcf Ξ± β πβ¦NTDGCodβ¦ = cat_FUNCT Ξ± (πβ¦NTDGDomβ¦) β"
unfolding exp_cat_ntcf_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda exp_cat_ntcf_components(1)
|vsv exp_cat_ntcf_components_NTMap_vsv[cat_FUNCT_cs_intros]|
context is_ntcf
begin
lemmas exp_cat_ntcf_components' =
exp_cat_ntcf_components[where Ξ±=Ξ± and π=π, unfolded cat_cs_simps]
lemmas [cat_FUNCT_cs_simps] = exp_cat_ntcf_components'(2-5)
mk_VLambda exp_cat_ntcf_components(1)[where π=π, unfolded cat_cs_simps]
|vdomain exp_cat_ntcf_components_NTMap_vdomain[cat_FUNCT_cs_simps]|
|app exp_cat_ntcf_components_NTMap_app[cat_FUNCT_cs_simps]|
end
lemmas exp_cat_ntcf_components' = is_ntcf.exp_cat_ntcf_components'
lemmas [cat_FUNCT_cs_simps] =
is_ntcf.exp_cat_ntcf_components'(2-5)
is_ntcf.exp_cat_ntcf_components_NTMap_vdomain
is_ntcf.exp_cat_ntcf_components_NTMap_app
subsubsectionβΉ
Category raised to the power of a natural transformation
is a natural transformation
βΊ
lemma exp_cat_ntcf_is_tiny_ntcf:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "category Ξ± β"
shows "exp_cat_ntcf Ξ± β π :
exp_cat_cf Ξ± β π β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y exp_cat_cf Ξ± β π :
cat_FUNCT Ξ± π
β β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π β"
proof(rule is_tiny_ntcfI')
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(3))
interpret β: category Ξ± β by (rule assms(4))
let ?exp_π = βΉexp_cat_ntcf Ξ± β πβΊ
let ?exp_π = βΉexp_cat_cf Ξ± β πβΊ
let ?exp_π = βΉexp_cat_cf Ξ± β πβΊ
from assms(1,2) show
"exp_cat_cf Ξ± β π : cat_FUNCT Ξ± π
β β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π β"
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(1,2) show
"exp_cat_cf Ξ± β π : cat_FUNCT Ξ± π
β β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β cat_FUNCT Ξ± π β"
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
show "?exp_π : ?exp_π β¦β©Cβ©F ?exp_π : cat_FUNCT Ξ± π
β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
proof(rule is_ntcfI')
show "vfsequence (?exp_π)" unfolding exp_cat_ntcf_def by auto
show "vcard (?exp_π) = 5β©β"
unfolding exp_cat_ntcf_def by (simp add: nat_omega_simps)
from assms(1,2) show
"exp_cat_cf Ξ± β π : cat_FUNCT Ξ± π
β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms(1,2) show
"exp_cat_cf Ξ± β π : cat_FUNCT Ξ± π
β β¦β¦β©CβΞ²β cat_FUNCT Ξ± π β"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show "exp_cat_ntcf Ξ± β πβ¦NTMapβ¦β¦ββ¦ :
exp_cat_cf Ξ± β πβ¦ObjMapβ¦β¦ββ¦ β¦βcat_FUNCT Ξ± π ββ
exp_cat_cf Ξ± β πβ¦ObjMapβ¦β¦ββ¦"
if "β ββ©β cat_FUNCT Ξ± π
ββ¦Objβ¦" for β
proof-
from that[unfolded cat_FUNCT_cs_simps] have "β ββ©β cf_maps Ξ± π
β" by simp
then obtain β' where β_def: "β = cf_map β'" and β': "β' : π
β¦β¦β©CβΞ±β β"
by auto
from β' show ?thesis
unfolding β_def
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps β_def
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"?exp_πβ¦NTMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π ββ ?exp_πβ¦ArrMapβ¦β¦πβ¦ =
?exp_πβ¦ArrMapβ¦β¦πβ¦ ββ©Aβcat_FUNCT Ξ± π ββ ?exp_πβ¦NTMapβ¦β¦πβ¦"
if "π : π β¦βcat_FUNCT Ξ± π
ββ π" for π π π
proof-
note π = cat_FUNCT_is_arrD[OF that]
let ?π = βΉcf_of_cf_map π
β πβΊ
and ?π = βΉcf_of_cf_map π
β πβΊ
and ?π = βΉntcf_of_ntcf_arrow π
β πβΊ
have [cat_cs_simps]:
"(?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) =
(?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)"
proof(rule ntcf_eqI)
from π(1) show
"(?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) :
?π ββ©Cβ©F π β¦β©Cβ©F ?π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from π(1) show
"(?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) :
?π ββ©Cβ©F π β¦β©Cβ©F ?π ββ©Cβ©F π : π β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
from π(1) have dom_lhs:
"πβ©β (((?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from π(1) have dom_rhs:
"πβ©β (((?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦) = πβ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"((?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦ =
((?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦Objβ¦"
with π(1) show
"((?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π))β¦NTMapβ¦β¦aβ¦ =
((?π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π) ββ©Nβ©Tβ©Cβ©F (?π ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps is_ntcf.ntcf_Comp_commute
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from π(1,3,4) that show ?thesis
by (subst (1 2) π(2), use nothing in βΉsubst π(3), subst π(4)βΊ)
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_cat_ntcf_is_tiny_ntcf'[cat_FUNCT_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "category Ξ± β"
and "π' = exp_cat_cf Ξ± β π"
and "π' = exp_cat_cf Ξ± β π"
and "π' = cat_FUNCT Ξ± π
β"
and "π
' = cat_FUNCT Ξ± π β"
shows "exp_cat_ntcf Ξ± β π : π' β¦β©Cβ©Fβ©.β©tβ©iβ©nβ©y π' : π' β¦β¦β©Cβ©.β©tβ©iβ©nβ©yβΞ²β π
'"
using assms(1-4) unfolding assms(5-8) by (rule exp_cat_ntcf_is_tiny_ntcf)
subsubsectionβΉFurther propertiesβΊ
lemma ntcf_id_exp_cat_cf:
assumes "category Ξ± π" and "π : π
β¦β¦β©CβΞ±β β"
shows "ntcf_id (exp_cat_cf Ξ± π π) = exp_cat_ntcf Ξ± π (ntcf_id π)"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² show "exp_cat_ntcf Ξ± π (ntcf_id π) :
exp_cat_cf Ξ± π π β¦β©Cβ©F exp_cat_cf Ξ± π π :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms Ξ² Ξ±Ξ² show "ntcf_id (exp_cat_cf Ξ± π π) :
exp_cat_cf Ξ± π π β¦β©Cβ©F exp_cat_cf Ξ± π π :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² assms have dom_lhs:
"πβ©β (exp_cat_ntcf Ξ± π (ntcf_id π)β¦NTMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² assms have dom_rhs:
"πβ©β (ntcf_id (exp_cat_cf Ξ± π π)β¦NTMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
show
"ntcf_id (exp_cat_cf Ξ± π π)β¦NTMapβ¦ = exp_cat_ntcf Ξ± π (ntcf_id π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume "π ββ©β cf_maps Ξ± β π"
then obtain π'
where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by auto
from π' Ξ±Ξ² show
"ntcf_id (exp_cat_cf Ξ± π π)β¦NTMapβ¦β¦πβ¦ =
exp_cat_ntcf Ξ± π (ntcf_id π)β¦NTMapβ¦β¦πβ¦"
unfolding π_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
cs_concl
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed simp_all
qed
lemma exp_cat_ntcf_ntcf_cf_comp:
assumes "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "β : π β¦β¦β©CβΞ±β π
"
and "category Ξ± π"
shows
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β) =
exp_cat_cf Ξ± π β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π"
proof-
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(1))
interpret β: is_functor Ξ± π π
β by (rule assms(2))
interpret π: category Ξ± π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)β¦NTMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cat_cf Ξ± π β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦) =
cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)β¦NTMapβ¦ =
(exp_cat_cf Ξ± π β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume prems: "π ββ©β cf_maps Ξ± β π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by (auto intro: is_arrI)
from Ξ±Ξ² assms prems π' show
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F β)β¦NTMapβ¦β¦πβ¦ =
(exp_cat_cf Ξ± π β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦β¦πβ¦"
unfolding π_def
by
(
cs_concl
cs_simp:
cf_ntcf_comp_ntcf_cf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
(
cs_concl
cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_cat_ntcf_cf_ntcf_comp:
assumes "π : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β π
"
and "β : π
β¦β¦β©CβΞ±β β"
and "category Ξ± π"
shows
"exp_cat_ntcf Ξ± π (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π) =
exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π β"
proof-
interpret π: is_ntcf Ξ± π π
π π π by (rule assms(1))
interpret β: is_functor Ξ± π
β β by (rule assms(2))
interpret π: category Ξ± π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ±Ξ² have dom_lhs:
"πβ©β (exp_cat_ntcf Ξ± π (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π β)β¦NTMapβ¦) =
cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cat_ntcf Ξ± π (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ =
(exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π β)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π assume prems: "π ββ©β cf_maps Ξ± β π"
then obtain π' where π_def: "π = cf_map π'" and π': "π' : β β¦β¦β©CβΞ±β π"
by (auto intro: is_arrI)
from assms Ξ±Ξ² prems π' show
"exp_cat_ntcf Ξ± π (β ββ©Cβ©Fβ©-β©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦πβ¦ =
(exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F exp_cat_cf Ξ± π β)β¦NTMapβ¦β¦πβ¦"
by
(
cs_concl
cs_simp:
cf_comp_cf_ntcf_comp_assoc cat_cs_simps cat_FUNCT_cs_simps π_def
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
(
cs_concl
cs_simp: exp_cat_cf_cf_comp cat_cs_simps cat_FUNCT_cs_simps
cs_intro: Ξ±Ξ² cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemma exp_cat_ntcf_ntcf_vcomp:
assumes "category Ξ± π"
and "π : π β¦β©Cβ©F β : π
β¦β¦β©CβΞ±β β"
and "π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©F π) =
exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π"
proof-
interpret π: category Ξ± π by (rule assms(1))
interpret π: is_ntcf Ξ± π
β π β π by (rule assms(2))
interpret π: is_ntcf Ξ± π
β π π π by (rule assms(3))
define Ξ² where "Ξ² = Ξ± + Ο"
have Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π.π΅_Limit_Ξ±Ο π.π΅_Ο_Ξ±Ο π΅_def π.π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
show ?thesis
proof(rule ntcf_eqI)
from Ξ² Ξ±Ξ² show
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©F π) :
exp_cat_cf Ξ± π π β¦β©Cβ©F exp_cat_cf Ξ± π β :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² show
"exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π :
exp_cat_cf Ξ± π π β¦β©Cβ©F exp_cat_cf Ξ± π β :
cat_FUNCT Ξ± β π β¦β¦β©CβΞ²β cat_FUNCT Ξ± π
π"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_lhs:
"πβ©β ((exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©F π))β¦NTMapβ¦) = cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from Ξ±Ξ² have dom_rhs:
"πβ©β ((exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦) =
cat_FUNCT Ξ± β πβ¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦ =
(exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_FUNCT_components(1))
fix π' assume "π' ββ©β cf_maps Ξ± β π"
then obtain π''
where π'_def: "π' = cf_map π''" and π'': "π'' : β β¦β¦β©CβΞ±β π"
by clarsimp
from π'' Ξ±Ξ² show
"exp_cat_ntcf Ξ± π (π ββ©Nβ©Tβ©Cβ©F π)β¦NTMapβ¦β¦π'β¦ =
(exp_cat_ntcf Ξ± π π ββ©Nβ©Tβ©Cβ©F exp_cat_ntcf Ξ± π π)β¦NTMapβ¦β¦π'β¦"
by
(
cs_concl
cs_simp:
cat_cs_simps cat_FUNCT_cs_simps cf_ntcf_comp_ntcf_vcomp π'_def
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)+
qed simp_all
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Hom
sectionβΉβΉHomβΊ-functorβΊ
theory CZH_ECAT_Hom
imports
CZH_ECAT_Set
CZH_ECAT_PCategory
begin
subsectionβΉβΉhomβΊ-functionβΊ
textβΉ
The βΉhomβΊ-function is a part of the definition of the βΉHomβΊ-functor,
as presented in \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
βΊ
definition cf_hom :: "V β V β V"
where "cf_hom β f =
[
(
Ξ»qββ©βHom β (ββ¦Codβ¦β¦vpfst fβ¦) (ββ¦Domβ¦β¦vpsnd fβ¦).
vpsnd f ββ©Aβββ q ββ©Aβββ vpfst f
),
Hom β (ββ¦Codβ¦β¦vpfst fβ¦) (ββ¦Domβ¦β¦vpsnd fβ¦),
Hom β (ββ¦Domβ¦β¦vpfst fβ¦) (ββ¦Codβ¦β¦vpsnd fβ¦)
]β©β"
textβΉComponents.βΊ
lemma cf_hom_components:
shows "cf_hom β fβ¦ArrValβ¦ =
(
Ξ»qββ©βHom β (ββ¦Codβ¦β¦vpfst fβ¦) (ββ¦Domβ¦β¦vpsnd fβ¦).
vpsnd f ββ©Aβββ q ββ©Aβββ vpfst f
)"
and "cf_hom β fβ¦ArrDomβ¦ = Hom β (ββ¦Codβ¦β¦vpfst fβ¦) (ββ¦Domβ¦β¦vpsnd fβ¦)"
and "cf_hom β fβ¦ArrCodβ¦ = Hom β (ββ¦Domβ¦β¦vpfst fβ¦) (ββ¦Codβ¦β¦vpsnd fβ¦)"
unfolding cf_hom_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda cf_hom_components(1)
|vsv cf_hom_ArrVal_vsv[cat_cs_intros]|
lemma cf_hom_ArrVal_vdomain[cat_cs_simps]:
assumes "g : a β¦βop_cat ββ b" and "f : a' β¦βββ b'"
shows "πβ©β (cf_hom β [g, f]β©ββ¦ArrValβ¦) = Hom β a a'"
using assms
unfolding cf_hom_components
by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
lemma cf_hom_ArrVal_app[cat_cs_simps]:
assumes "g : c β¦βop_cat ββ d" and "q : c β¦βββ c'" and "f : c' β¦βββ d'"
shows "cf_hom β [g, f]β©ββ¦ArrValβ¦β¦qβ¦ = f ββ©Aβββ q ββ©Aβββ g"
using assms
unfolding cf_hom_components
by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
lemma (in category) cf_hom_ArrVal_vrange:
assumes "g : a β¦βop_cat ββ b" and "f : a' β¦βββ b'"
shows "ββ©β (cf_hom β [g, f]β©ββ¦ArrValβ¦) ββ©β Hom β b b'"
proof(intro vsubsetI)
interpret gf: vsv βΉcf_hom β [g, f]β©ββ¦ArrValβ¦βΊ
unfolding cf_hom_components by auto
fix y assume "y ββ©β ββ©β (cf_hom β [g, f]β©ββ¦ArrValβ¦)"
then obtain q where y_def: "y = cf_hom β [g, f]β©ββ¦ArrValβ¦β¦qβ¦"
and "q ββ©β πβ©β (cf_hom β [g, f]β©ββ¦ArrValβ¦)"
by (metis gf.vrange_atD)
then have q: "q : a β¦βββ a'"
unfolding cf_hom_ArrVal_vdomain[OF assms] by simp
from assms q show "y ββ©β Hom β b b'"
unfolding y_def cf_hom_ArrVal_app[OF assms(1) q assms(2)] cat_op_simps
by (auto intro: cat_cs_intros)
qed
subsubsectionβΉArrow domainβΊ
lemma (in category) cf_hom_ArrDom:
assumes "gf : [c, c']β©β β¦βop_cat β Γβ©C ββ dd'"
shows "cf_hom β gfβ¦ArrDomβ¦ = Hom β c c'"
proof-
from assms obtain g f d d'
where "gf = [g, f]β©β" and "g : c β¦βop_cat ββ d" and "f : c' β¦βββ d'"
unfolding cf_hom_components
by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
then show ?thesis
unfolding cf_hom_components
by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
qed
lemmas [cat_cs_simps] = category.cf_hom_ArrDom
subsubsectionβΉArrow codomainβΊ
lemma (in category) cf_hom_ArrCod:
assumes "gf : cc' β¦βop_cat β Γβ©C ββ [d, d']β©β"
shows "cf_hom β gfβ¦ArrCodβ¦ = Hom β d d'"
proof-
from assms obtain g f c c'
where "gf = [g, f]β©β" and "g : c β¦βop_cat ββ d" and "f : c' β¦βββ d'"
unfolding cf_hom_components
by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
then show ?thesis
unfolding cf_hom_components
by (simp_all add: nat_omega_simps cat_op_simps cat_cs_simps)
qed
lemmas [cat_cs_simps] = category.cf_hom_ArrCod
subsubsectionβΉβΉhomβΊ-function is an arrow in the category βΉSetβΊβΊ
lemma (in category) cat_cf_hom_ArrRel:
assumes "gf : cc' β¦βop_cat β Γβ©C ββ dd'"
shows "arr_Set Ξ± (cf_hom β gf)"
proof(intro arr_SetI)
from assms obtain g f c c' d d'
where gf_def: "gf = [g, f]β©β"
and cc'_def: "cc' = [c, c']β©β"
and dd'_def: "dd' = [d, d']β©β"
and op_g: "g : c β¦βop_cat ββ d"
and f: "f : c' β¦βββ d'"
unfolding cf_hom_components
by (elim cat_prod_2_is_arrE[rotated 2]) (auto intro: cat_cs_intros)
from op_g have g: "g : d β¦βββ c" unfolding cat_op_simps by simp
then have [simp]: "ββ¦Domβ¦β¦gβ¦ = d" "ββ¦Codβ¦β¦gβ¦ = c"
and d: "d ββ©β ββ¦Objβ¦" and c: "c ββ©β ββ¦Objβ¦"
by auto
from f have [simp]: "ββ¦Domβ¦β¦fβ¦ = c'" "ββ¦Codβ¦β¦fβ¦ = d'"
and c': "c' ββ©β ββ¦Objβ¦" and d': "d' ββ©β ββ¦Objβ¦"
by auto
show "vfsequence (cf_hom β gf)" unfolding cf_hom_def by simp
show vsv_hom_fg: "vsv (cf_hom β gfβ¦ArrValβ¦)"
unfolding cf_hom_components by auto
show "vcard (cf_hom β gf) = 3β©β"
unfolding cf_hom_def by (simp add: nat_omega_simps)
show [simp]: "πβ©β (cf_hom β gfβ¦ArrValβ¦) = cf_hom β gfβ¦ArrDomβ¦"
unfolding cf_hom_components by auto
show "ββ©β (cf_hom β gfβ¦ArrValβ¦) ββ©β cf_hom β gfβ¦ArrCodβ¦"
proof(rule vsubsetI)
interpret hom_fg: vsv βΉcf_hom β gfβ¦ArrValβ¦βΊ by (simp add: vsv_hom_fg)
fix y assume "y ββ©β ββ©β (cf_hom β gfβ¦ArrValβ¦)"
then obtain q where y_def: "y = cf_hom β gfβ¦ArrValβ¦β¦qβ¦"
and q: "q ββ©β πβ©β (cf_hom β gfβ¦ArrValβ¦)"
by (blast dest: hom_fg.vrange_atD)
from q have q: "q : c β¦βββ c'"
by (simp add: cf_hom_ArrDom[OF assms[unfolded cc'_def]])
with g f have "f ββ©Aβββ q ββ©Aβββ g : d β¦βββ d'"
by (auto intro: cat_cs_intros)
then show "y ββ©β cf_hom β gfβ¦ArrCodβ¦"
unfolding cf_hom_ArrCod[OF assms[unfolded dd'_def]]
unfolding y_def gf_def cf_hom_ArrVal_app[OF op_g q f]
by auto
qed
from c c' show "cf_hom β gfβ¦ArrDomβ¦ ββ©β Vset Ξ±"
unfolding cf_hom_components gf_def
by (auto simp: nat_omega_simps intro: cat_cs_intros)
from d d' show "cf_hom β gfβ¦ArrCodβ¦ ββ©β Vset Ξ±"
unfolding cf_hom_components gf_def
by (auto simp: nat_omega_simps intro: cat_cs_intros)
qed auto
lemmas [cat_cs_intros] = category.cat_cf_hom_ArrRel
lemma (in category) cat_cf_hom_cat_Set_is_arr:
assumes "gf : [a, b]β©β β¦βop_cat β Γβ©C ββ [c, d]β©β"
shows "cf_hom β gf : Hom β a b β¦βcat_Set Ξ±β Hom β c d"
proof(intro is_arrI)
from assms cat_cf_hom_ArrRel show "cf_hom β gf ββ©β cat_Set Ξ±β¦Arrβ¦"
unfolding cat_Set_components by auto
with assms show
"cat_Set Ξ±β¦Domβ¦β¦cf_hom β gfβ¦ = Hom β a b"
"cat_Set Ξ±β¦Codβ¦β¦cf_hom β gfβ¦ = Hom β c d"
unfolding cat_Set_components
by (simp_all add: cf_hom_ArrDom[OF assms] cf_hom_ArrCod[OF assms])
qed
lemma (in category) cat_cf_hom_cat_Set_is_arr':
assumes "gf : [a, b]β©β β¦βop_cat β Γβ©C ββ [c, d]β©β"
and "π' = Hom β a b"
and "π
' = Hom β c d"
and "β' = cat_Set Ξ±"
shows "cf_hom β gf : π' β¦ββ'β π
'"
using assms(1) unfolding assms(2-4) by (rule cat_cf_hom_cat_Set_is_arr)
lemmas [cat_cs_intros] = category.cat_cf_hom_cat_Set_is_arr'
subsubsectionβΉCompositionβΊ
lemma (in category) cat_cf_hom_Comp:
assumes "g : b β¦βop_cat ββ c"
and "g' : b' β¦βββ c'"
and "f : a β¦βop_cat ββ b"
and "f' : a' β¦βββ b'"
shows
"cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β =
cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©β"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
from assms(1,3) have g: "g : c β¦βββ b" and f: "f : b β¦βββ a"
unfolding cat_op_simps by simp_all
from assms(2,4) g f Set.category_axioms category_axioms have gg'_ff':
"cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β :
Hom β a a' β¦βcat_Set Ξ±β Hom β c c'"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
then have dom_lhs:
"πβ©β ((cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β)β¦ArrValβ¦) =
Hom β a a'"
by (cs_concl cs_simp: cat_cs_simps)+
from assms(2,4) g f Set.category_axioms category_axioms have gf_g'f':
"cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©β :
Hom β a a' β¦βcat_Set Ξ±β Hom β c c'"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
then have dom_rhs:
"πβ©β (cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©ββ¦ArrValβ¦) = Hom β a a'"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from gg'_ff' show arr_Set_gg'_ff':
"arr_Set Ξ± (cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β)"
by (auto dest: cat_Set_is_arrD(1))
from gf_g'f' show arr_Set_gf_g'f':
"arr_Set Ξ± (cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©β)"
by (auto dest: cat_Set_is_arrD(1))
show "(cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β)β¦ArrValβ¦ =
cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©ββ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix q assume "q ββ©β Hom β a a'"
then have q: "q : a β¦βββ a'" by auto
from category_axioms g f assms(2,4) q Set.category_axioms show
"(cf_hom β [g, g']β©β ββ©Aβcat_Set Ξ±β cf_hom β [f, f']β©β)β¦ArrValβ¦β¦qβ¦ =
cf_hom β [g ββ©Aβop_cat ββ f, g' ββ©Aβββ f']β©ββ¦ArrValβ¦β¦qβ¦"
by
(
cs_concl
cs_intro: cat_op_intros cat_cs_intros cat_prod_cs_intros
cs_simp: cat_op_simps cat_cs_simps
)
qed (use arr_Set_gg'_ff' arr_Set_gf_g'f' in auto)
qed (use gg'_ff' gf_g'f' in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_cf_hom_Comp
subsubsectionβΉIdentityβΊ
lemma (in category) cat_cf_hom_CId:
assumes "[c, c']β©β ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
shows "cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©β = cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
interpret op_β: category Ξ± βΉop_cat ββΊ by (rule category_op)
from assms have op_c: "c ββ©β op_cat ββ¦Objβ¦" and c': "c' ββ©β ββ¦Objβ¦"
by (auto elim: cat_prod_2_ObjE[rotated 2] intro: cat_cs_intros)
then have c: "c ββ©β ββ¦Objβ¦" unfolding cat_op_simps by simp
from c c' category_axioms Set.category_axioms have cf_hom_cc':
"cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©β : Hom β c c' β¦βcat_Set Ξ±β Hom β c c'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs: "πβ©β (cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©ββ¦ArrValβ¦) = Hom β c c'"
by (cs_concl cs_simp: cat_cs_simps)
from c c' category_axioms Set.category_axioms have CId_cc':
"cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦ : Hom β c c' β¦βcat_Set Ξ±β Hom β c c'"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros cat_prod_cs_intros
)
then have dom_rhs: "πβ©β (cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦β¦ArrValβ¦) = Hom β c c'"
by (cs_concl cs_simp: cat_cs_simps )
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from cf_hom_cc' show arr_Set_CId_cc':
"arr_Set Ξ± (cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©β)"
by (auto dest: cat_Set_is_arrD(1))
from CId_cc' show arr_Set_Hom_cc':
"arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦)"
by (auto simp: cat_Set_is_arrD(1))
show "cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©ββ¦ArrValβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix q assume "q : c β¦βββ c'"
with category_axioms show
"cf_hom β [ββ¦CIdβ¦β¦cβ¦, ββ¦CIdβ¦β¦c'β¦]β©ββ¦ArrValβ¦β¦qβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦Hom β c c'β¦β¦ArrValβ¦β¦qβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_Set_cs_simps
cs_intro: cat_cs_intros
)
qed (use arr_Set_CId_cc' arr_Set_Hom_cc' in auto)
qed (use cf_hom_cc' CId_cc' in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_cf_hom_CId
subsubsectionβΉOpposite βΉhomβΊ-functionβΊ
lemma (in category) cat_op_cat_cf_hom:
assumes "g : a β¦βββ b" and "g' : a' β¦βop_cat ββ b'"
shows "cf_hom (op_cat β) [g, g']β©β = cf_hom β [g', g]β©β"
proof(rule arr_Set_eqI[of Ξ±])
from assms show "arr_Set Ξ± (cf_hom (op_cat β) [g, g']β©β)"
by
(
cs_concl
cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
from assms show "arr_Set Ξ± (cf_hom β [g', g]β©β)"
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from assms have dom_lhs:
"πβ©β (cf_hom (op_cat β) [g, g']β©ββ¦ArrValβ¦) = Hom β a' a"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from assms have dom_rhs: "πβ©β (cf_hom β [g', g]β©ββ¦ArrValβ¦) = Hom β a' a"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "cf_hom (op_cat β) [g, g']β©ββ¦ArrValβ¦ = cf_hom β [g', g]β©ββ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : a' β¦βββ a"
with assms show
"cf_hom (op_cat β) [g, g']β©ββ¦ArrValβ¦β¦fβ¦ = cf_hom β [g', g]β©ββ¦ArrValβ¦β¦fβ¦"
unfolding cat_op_simps
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed (simp_all add: cf_hom_components)
from category_axioms assms show
"cf_hom (op_cat β) [g, g']β©ββ¦ArrDomβ¦ = cf_hom β [g', g]β©ββ¦ArrDomβ¦"
by
(
cs_concl
cs_simp: category.cf_hom_ArrDom cat_op_simps
cs_intro: cat_op_intros cat_prod_cs_intros
)
from category_axioms assms show
"cf_hom (op_cat β) [g, g']β©ββ¦ArrCodβ¦ = cf_hom β [g', g]β©ββ¦ArrCodβ¦"
by
(
cs_concl
cs_simp: category.cf_hom_ArrCod cat_op_simps
cs_intro: cat_op_intros cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_op_cat_cf_hom
subsectionβΉβΉHomβΊ-functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
βΊ
definition cf_Hom :: "V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/-,-/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(-,-) =
[
(Ξ»aββ©β(op_cat β Γβ©C β)β¦Objβ¦. Hom β (vpfst a) (vpsnd a)),
(Ξ»fββ©β(op_cat β Γβ©C β)β¦Arrβ¦. cf_hom β f),
op_cat β Γβ©C β,
cat_Set Ξ±
]β©β"
textβΉComponents.βΊ
lemma cf_Hom_components:
shows "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦ =
(Ξ»aββ©β(op_cat β Γβ©C β)β¦Objβ¦. Hom β (vpfst a) (vpsnd a))"
and "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦ = (Ξ»fββ©β(op_cat β Γβ©C β)β¦Arrβ¦. cf_hom β f)"
and "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦HomDomβ¦ = op_cat β Γβ©C β"
and "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦HomCodβ¦ = cat_Set Ξ±"
unfolding cf_Hom_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda cf_Hom_components(1)
|vsv cf_Hom_ObjMap_vsv|
lemma cf_Hom_ObjMap_vdomain[cat_cs_simps]:
"πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦) = (op_cat β Γβ©C β)β¦Objβ¦"
unfolding cf_Hom_components by simp
lemma cf_Hom_ObjMap_app[cat_cs_simps]:
assumes "[a, b]β©β ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦a, bβ¦β©β = Hom β a b"
using assms unfolding cf_Hom_components by (simp add: nat_omega_simps)
lemma (in category) cf_Hom_ObjMap_vrange:
"ββ©β (Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦) ββ©β cat_Set Ξ±β¦Objβ¦"
proof(intro vsubsetI)
interpret op_β: category Ξ± βΉop_cat ββΊ by (simp add: category_op)
fix y assume "y ββ©β ββ©β (Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦)"
then obtain x where y_def: "y = Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦xβ¦"
and x: "x ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
unfolding cf_Hom_components by auto
then obtain a b where x_def: "x = [a, b]β©β"
and a: "a ββ©β op_cat ββ¦Objβ¦"
and b: "b ββ©β ββ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF op_β.category_axioms category_axioms x])
from a have a: "a ββ©β ββ¦Objβ¦" unfolding cat_op_simps by simp
from a b show "y ββ©β cat_Set Ξ±β¦Objβ¦"
unfolding
y_def x_def cf_Hom_ObjMap_app[OF x[unfolded x_def]] cat_Set_components
by (auto simp: cat_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_Hom_components(2)
|vsv cf_Hom_ArrMap_vsv|
|vdomain cf_Hom_ArrMap_vdomain[cat_cs_simps]|
|app cf_Hom_ArrMap_app[cat_cs_simps]|
subsubsectionβΉβΉHomβΊ-functor is a functorβΊ
lemma (in category) cat_Hom_is_functor:
"Homβ©Oβ©.β©CβΞ±ββ(-,-) : op_cat β Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
interpret ββ: category Ξ± βΉop_cat β Γβ©C ββΊ
by (simp add: category_axioms category_cat_prod_2 category_op)
interpret op_β: category Ξ± βΉop_cat ββΊ by (rule category_op)
show ?thesis
proof(intro is_functorI')
show "vfsequence Homβ©Oβ©.β©CβΞ±ββ(-,-)"
unfolding cf_Hom_def by simp
show op_β_β: "category Ξ± (op_cat β Γβ©C β)" by (auto simp: cat_cs_intros)
show "vcard Homβ©Oβ©.β©CβΞ±ββ(-,-) = 4β©β"
unfolding cf_Hom_def by (simp add: nat_omega_simps)
show "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦) ββ©β cat_Set Ξ±β¦Objβ¦"
by (simp add: cf_Hom_ObjMap_vrange)
show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦gfβ¦ :
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦abβ¦ β¦βcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦cdβ¦"
if gf: "gf : ab β¦βop_cat β Γβ©C ββ cd" for gf ab cd
unfolding slicing_simps cat_smc_cat_Set[symmetric]
proof-
obtain g f a b c d where gf_def: "gf = [g, f]β©β"
and ab_def: "ab = [a, b]β©β"
and cd_def: "cd = [c, d]β©β"
and "g : a β¦βop_cat ββ c"
and f: "f : b β¦βββ d"
by (elim cat_prod_2_is_arrE[OF category_op category_axioms gf])
then have g: "g : c β¦βββ a" unfolding cat_op_simps by simp
from category_axioms that g f show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦gfβ¦ :
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦abβ¦ β¦βcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦cdβ¦"
unfolding gf_def ab_def cd_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
qed
show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦gg' ββ©Aβop_cat β Γβ©C ββ ff'β¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦gg'β¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦ff'β¦"
if gg': "gg' : bb' β¦βop_cat β Γβ©C ββ cc'"
and ff': "ff' : aa' β¦βop_cat β Γβ©C ββ bb'"
for gg' bb' cc' ff' aa'
proof-
obtain g g' b b' c c'
where gg'_def: "gg' = [g, g']β©β"
and bb'_def: "bb' = [b, b']β©β"
and cc'_def: "cc' = [c, c']β©β"
and "g : b β¦βop_cat ββ c"
and g': "g' : b' β¦βββ c'"
by (elim cat_prod_2_is_arrE[OF category_op category_axioms gg'])
moreover obtain f f' a a' b'' b'''
where ff'_def: "ff' = [f, f']β©β"
and aa'_def: "aa' = [a, a']β©β"
and "bb' = [b'', b''']β©β"
and "f : a β¦βop_cat ββ b''"
and "f' : a' β¦βββ b'''"
by (elim cat_prod_2_is_arrE[OF category_op category_axioms ff'])
ultimately have f: "f : b β¦βββ a"
and f': "f' : a' β¦βββ b'"
and g: "g : c β¦βββ b"
by (auto simp: cat_op_simps)
from category_axioms that g f g' f' show ?thesis
unfolding
slicing_simps cat_smc_cat_Set[symmetric]
gg'_def bb'_def cc'_def ff'_def aa'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦(op_cat β Γβ©C β)β¦CIdβ¦β¦cc'β¦β¦ =
cat_Set Ξ±β¦CIdβ¦β¦Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦cc'β¦β¦"
if "cc' ββ©β (op_cat β Γβ©C β)β¦Objβ¦" for cc'
proof-
from that obtain c c'
where cc'_def: "cc' = [c, c']β©β"
and c: "c ββ©β op_cat ββ¦Objβ¦"
and c': "c' ββ©β ββ¦Objβ¦"
by (elim cat_prod_2_ObjE[rotated 2]) (auto intro: cat_cs_intros)
then have c: "c ββ©β ββ¦Objβ¦" unfolding cat_op_simps by simp
with c' category_axioms Set.category_axioms that show ?thesis
unfolding cc'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_prod_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_Hom_components cat_cs_intros)
qed
lemma (in category) cat_Hom_is_functor':
assumes "Ξ² = Ξ±" and "π' = op_cat β Γβ©C β" and "π
' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,-) : π' β¦β¦β©CβΞ²β π
'"
unfolding assms by (rule cat_Hom_is_functor)
lemmas [cat_cs_intros] = category.cat_Hom_is_functor'
subsectionβΉComposition of a βΉHomβΊ-functor and two functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cf_bcomp_Hom :: "V β V β V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/_-,_-/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(π-,π-) = cf_cn_cov_bcomp (Homβ©Oβ©.β©CβΞ±ββ(-,-)) π π"
subsubsectionβΉObject mapβΊ
lemma cf_bcomp_Hom_ObjMap_vsv: "vsv (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ObjMapβ¦)"
unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_vsv)
lemma cf_bcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ObjMapβ¦) = (op_cat π Γβ©C π
)β¦Objβ¦"
using assms unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_vdomain)
lemma cf_bcomp_Hom_ObjMap_app[cat_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "[a, b]β©β ββ©β (op_cat π Γβ©C π
)β¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ObjMapβ¦β¦a, bβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦aβ¦, πβ¦ObjMapβ¦β¦bβ¦β¦β©β"
using assms unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ObjMap_app)
lemma (in category) cf_bcomp_Hom_ObjMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ObjMapβ¦) ββ©β cat_Set Ξ±β¦Objβ¦"
using category_axioms
unfolding cf_bcomp_Hom_def
by (intro cf_cn_cov_bcomp_ObjMap_vrange[OF assms])
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
subsubsectionβΉArrow mapβΊ
lemma cf_bcomp_Hom_ArrMap_vsv: "vsv (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ArrMapβ¦)"
unfolding cf_bcomp_Hom_def by (rule cf_cn_cov_bcomp_ArrMap_vsv)
lemma cf_bcomp_Hom_ArrMap_vdomain[cat_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ArrMapβ¦) = (op_cat π Γβ©C π
)β¦Arrβ¦"
using assms
unfolding cf_bcomp_Hom_def
by (rule cf_cn_cov_bcomp_ArrMap_vdomain)
lemma cf_bcomp_Hom_ArrMap_app[cat_cs_simps]:
assumes "π : π β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "[f, g]β©β ββ©β (op_cat π Γβ©C π
)β¦Arrβ¦"
shows
"Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ArrMapβ¦β¦f, gβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦fβ¦, πβ¦ArrMapβ¦β¦gβ¦β¦β©β"
using assms
unfolding cf_bcomp_Hom_def
by (rule cf_cn_cov_bcomp_ArrMap_app)
lemma (in category) cf_bcomp_Hom_ArrMap_vrange:
assumes "π : π β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,π-)β¦ArrMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
using category_axioms
unfolding cf_bcomp_Hom_def
by (intro cf_cn_cov_bcomp_ArrMap_vrange[OF assms])
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
subsubsectionβΉComposition of a βΉHomβΊ-functor and two functors is a functorβΊ
lemma (in category) cat_cf_bcomp_Hom_is_functor:
assumes "π : π β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,π-) : op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
using assms category_axioms
unfolding cf_bcomp_Hom_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma (in category) cat_cf_bcomp_Hom_is_functor':
assumes "π : π β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = op_cat π Γβ©C π
"
and "π
' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,π-) : π' β¦β¦β©CβΞ²β π
'"
using assms(1,2) unfolding assms(3-5) by (rule cat_cf_bcomp_Hom_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_bcomp_Hom_is_functor'
subsectionβΉComposition of a βΉHomβΊ-functor and a functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee subsection 1.15 in \cite{bodo_categories_1970}.βΊ
definition cf_lcomp_Hom :: "V β V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/_-,-/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(π-,-) = cf_cn_cov_lcomp β (Homβ©Oβ©.β©CβΞ±ββ(-,-)) π"
definition cf_rcomp_Hom :: "V β V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/-,_-/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(-,π-) = cf_cn_cov_rcomp β (Homβ©Oβ©.β©CβΞ±ββ(-,-)) π"
subsubsectionβΉObject mapβΊ
lemma cf_lcomp_Hom_ObjMap_vsv[cat_cs_intros]: "vsv (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ObjMapβ¦)"
unfolding cf_lcomp_Hom_def by (rule cf_cn_cov_lcomp_ObjMap_vsv)
lemma cf_rcomp_Hom_ObjMap_vsv[cat_cs_intros]: "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦)"
unfolding cf_rcomp_Hom_def by (rule cf_cn_cov_rcomp_ObjMap_vsv)
lemma cf_lcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ObjMapβ¦) = (op_cat π
Γβ©C β)β¦Objβ¦"
using assms
by (cs_concl cs_simp: cat_cs_simps cf_lcomp_Hom_def cs_intro: cat_cs_intros)
lemma cf_rcomp_Hom_ObjMap_vdomain[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦) = (op_cat β Γβ©C π
)β¦Objβ¦"
using assms
by (cs_concl cs_simp: cat_cs_simps cf_rcomp_Hom_def cs_intro: cat_cs_intros)
lemma cf_lcomp_Hom_ObjMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π
β¦β¦β©CβΞ±β β"
and "b ββ©β op_cat π
β¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ObjMapβ¦β¦b, cβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦bβ¦, cβ¦β©β"
using assms
unfolding cf_lcomp_Hom_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_prod_cs_intros)
lemma cf_rcomp_Hom_ObjMap_app[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "c ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦β¦c, bβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦c, πβ¦ObjMapβ¦β¦bβ¦β¦β©β"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cf_rcomp_Hom_def
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
lemma (in category) cat_cf_lcomp_Hom_ObjMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ObjMapβ¦) ββ©β cat_Set Ξ±β¦Objβ¦"
using category_axioms assms
unfolding cf_lcomp_Hom_def
by (intro cf_cn_cov_lcomp_ObjMap_vrange)
(cs_concl cs_intro: cat_cs_intros)
lemma (in category) cat_cf_rcomp_Hom_ObjMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦) ββ©β cat_Set Ξ±β¦Objβ¦"
using category_axioms assms
unfolding cf_rcomp_Hom_def
by (intro cf_cn_cov_rcomp_ObjMap_vrange)
(cs_concl cs_intro: cat_cs_intros)
subsubsectionβΉArrow mapβΊ
lemma cf_lcomp_Hom_ArrMap_vsv[cat_cs_intros]: "vsv (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦)"
unfolding cf_lcomp_Hom_def by (rule cf_cn_cov_lcomp_ArrMap_vsv)
lemma cf_rcomp_Hom_ArrMap_vsv[cat_cs_intros]: "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦)"
unfolding cf_rcomp_Hom_def by (rule cf_cn_cov_rcomp_ArrMap_vsv)
lemma cf_lcomp_Hom_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦) = (op_cat π
Γβ©C β)β¦Arrβ¦"
using assms
unfolding cf_lcomp_Hom_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma cf_rcomp_Hom_ArrMap_vdomain[cat_cs_simps]:
assumes "category Ξ± β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦) = (op_cat β Γβ©C π
)β¦Arrβ¦"
using assms unfolding cf_rcomp_Hom_def by (cs_concl cs_simp: cat_cs_simps)
lemma cf_lcomp_Hom_ArrMap_app[cat_cs_simps]:
assumes "category Ξ± β"
and "π : π
β¦β¦β©CβΞ±β β"
and "g : a β¦βop_cat π
β b"
and "f : a' β¦βββ b'"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦β¦g, fβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦πβ¦ArrMapβ¦β¦gβ¦, fβ¦β©β"
using assms
unfolding cf_lcomp_Hom_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemma cf_rcomp_Hom_ArrMap_app[cat_cs_simps]:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "g : a β¦βop_cat ββ b"
and "f : a' β¦βπ
β b'"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦β¦g, fβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦β¦g, πβ¦ArrMapβ¦β¦fβ¦β¦β©β"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cf_rcomp_Hom_def
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
lemma (in category) cf_lcomp_Hom_ArrMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
using category_axioms assms
unfolding cf_lcomp_Hom_def
by (intro cf_cn_cov_lcomp_ArrMap_vrange)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemma (in category) cf_rcomp_Hom_ArrMap_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
using category_axioms assms
unfolding cf_rcomp_Hom_def
by (intro cf_cn_cov_rcomp_ArrMap_vrange)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
subsubsectionβΉFurther propertiesβΊ
lemma cf_bcomp_Hom_cf_lcomp_Hom[cat_cs_simps]:
"Homβ©Oβ©.β©CβΞ±ββ(π-,cf_id β-) = Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
unfolding cf_lcomp_Hom_def cf_cn_cov_lcomp_def cf_bcomp_Hom_def ..
lemma cf_bcomp_Hom_cf_rcomp_Hom[cat_cs_simps]:
"Homβ©Oβ©.β©CβΞ±ββ(cf_id β-,π-) = Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
unfolding cf_rcomp_Hom_def cf_cn_cov_rcomp_def cf_bcomp_Hom_def ..
subsubsectionβΉComposition of a βΉHomβΊ-functor and a functor is a functorβΊ
lemma (in category) cat_cf_lcomp_Hom_is_functor:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-) : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
using category_axioms assms
unfolding cf_lcomp_Hom_def
by (intro cf_cn_cov_lcomp_is_functor)
(cs_concl cs_intro: cat_cs_intros)
lemma (in category) cat_cf_lcomp_Hom_is_functor':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = op_cat π
Γβ©C β"
and "π
' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-) : π' β¦β¦β©CβΞ²β π
'"
using assms(1)
unfolding assms(2-4)
by (rule cat_cf_lcomp_Hom_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_lcomp_Hom_is_functor'
lemma (in category) cat_cf_rcomp_Hom_is_functor:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-) : op_cat β Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
using category_axioms assms
unfolding cf_rcomp_Hom_def
by (intro cf_cn_cov_rcomp_is_functor)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)
lemma (in category) cat_cf_rcomp_Hom_is_functor':
assumes "π : π
β¦β¦β©CβΞ±β β" and "Ξ² = Ξ±"
and "π' = op_cat β Γβ©C π
"
and "π
' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-) : π' β¦β¦β©CβΞ²β π
'"
using assms(1)
unfolding assms(2-4)
by (rule cat_cf_rcomp_Hom_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_rcomp_Hom_is_functor'
subsubsectionβΉFlip of a projections of a βΉHomβΊ-functorβΊ
lemma (in category) cat_bifunctor_flip_cf_rcomp_Hom:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows
"bifunctor_flip (op_cat β) π
(Homβ©Oβ©.β©CβΞ±ββ(-,π-)) =
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)"
proof(rule cf_eqI)
interpret π: is_functor Ξ± π
β π by (rule assms)
from category_axioms assms show bf_Hom:
"bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-) :
π
Γβ©C op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from category_axioms assms show op_Hom:
"Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-) : π
Γβ©C op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
from bf_Hom have ObjMap_dom_lhs:
"πβ©β (bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦) =
(π
Γβ©C op_cat β)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from op_Hom have ObjMap_dom_rhs:
"πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ObjMapβ¦) = (π
Γβ©C op_cat β)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from bf_Hom have ArrMap_dom_lhs:
"πβ©β (bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦) =
(π
Γβ©C op_cat β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from op_Hom have ArrMap_dom_rhs:
"πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ArrMapβ¦) = (π
Γβ©C op_cat β)β¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦ =
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix bc assume "bc ββ©β (π
Γβ©C op_cat β)β¦Objβ¦"
then obtain b c
where bc_def: "bc = [b, c]β©β" and b: "b ββ©β π
β¦Objβ¦" and c: "c ββ©β ββ¦Objβ¦"
by
(
auto
elim: cat_prod_2_ObjE[OF π.HomDom.category_axioms category_op]
simp: cat_op_simps
)
from category_axioms assms b c show
"bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ObjMapβ¦β¦bcβ¦ =
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ObjMapβ¦β¦bcβ¦"
unfolding bc_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto intro: cat_cs_intros)
show
"bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦ =
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix gf assume "gf ββ©β (π
Γβ©C op_cat β)β¦Arrβ¦"
then obtain g f
where gf_def: "gf = [g, f]β©β" and "g ββ©β π
β¦Arrβ¦" and "f ββ©β ββ¦Arrβ¦"
by
(
auto
elim: cat_prod_2_ArrE[OF π.HomDom.category_axioms category_op]
simp: cat_op_simps
)
then obtain a b c d where g: "g : a β¦βπ
β b" and f: "f : c β¦βββ d"
by (auto intro!: is_arrI)
from category_axioms assms g f show
"bifunctor_flip (op_cat β) π
Homβ©Oβ©.β©CβΞ±ββ(-,π-)β¦ArrMapβ¦β¦gfβ¦ =
Homβ©Oβ©.β©CβΞ±βop_cat β(op_cf π-,-)β¦ArrMapβ¦β¦gfβ¦"
unfolding gf_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto intro: cat_cs_intros)
qed (auto intro: cat_cs_intros simp: cat_op_simps)
lemmas [cat_cs_simps] = category.cat_bifunctor_flip_cf_rcomp_Hom
lemma (in category) cat_bifunctor_flip_cf_lcomp_Hom:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows
"bifunctor_flip (op_cat π
) β (Homβ©Oβ©.β©CβΞ±ββ(π-,-)) =
Homβ©Oβ©.β©CβΞ±βop_cat β(-,op_cf π-)"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
note Hom_π =
category.cat_bifunctor_flip_cf_rcomp_Hom
[
OF category_op is_functor_op[OF assms],
unfolded cat_op_simps,
symmetric
]
from category_axioms assms show ?thesis
by (subst Hom_π)
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)+
qed
lemmas [cat_cs_simps] = category.cat_bifunctor_flip_cf_lcomp_Hom
subsectionβΉProjections of the βΉHomβΊ-functorβΊ
textβΉ
The projections of the βΉHomβΊ-functor coincide with the definitions
of the βΉHomβΊ-functor given in Chapter II-2 in \cite{mac_lane_categories_2010}.
They are also exposed in the aforementioned article in
nLab \cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/hom-functor
}}.
βΊ
subsubsectionβΉDefinitions and elementary propertiesβΊ
definition cf_Hom_snd :: "V β V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/_,-/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(a,-) = Homβ©Oβ©.β©CβΞ±ββ(-,-)βop_cat β,ββ(a,-)β©Cβ©F"
definition cf_Hom_fst :: "V β V β V β V" (βΉHomβ©Oβ©.β©CΔ±_'(/-,_/')βΊ)
where "Homβ©Oβ©.β©CβΞ±ββ(-,b) = Homβ©Oβ©.β©CβΞ±ββ(-,-)βop_cat β,ββ(-,b)β©Cβ©F"
subsubsectionβΉProjections of the βΉHomβΊ-functor are functorsβΊ
lemma (in category) cat_cf_Hom_snd_is_functor:
assumes "a ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from assms have a: "a ββ©β op_cat ββ¦Objβ¦" unfolding cat_op_simps by simp
have op_β: "category Ξ± (op_cat β)" by (auto intro: cat_cs_intros)
from op_β category_axioms cat_Hom_is_functor a show ?thesis
unfolding cf_Hom_snd_def by (rule bifunctor_proj_snd_is_functor)
qed
lemma (in category) cat_cf_Hom_snd_is_functor':
assumes "a ββ©β ββ¦Objβ¦" and "Ξ² = Ξ±" and "β' = β" and "π' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(a,-) : β' β¦β¦β©CβΞ²β π'"
using assms(1) unfolding assms(2-4) by (rule cat_cf_Hom_snd_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_is_functor'
lemma (in category) cat_cf_Hom_fst_is_functor:
assumes "b ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,b) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
have op_β: "category Ξ± (op_cat β)" by (auto intro: cat_cs_intros)
from op_β category_axioms cat_Hom_is_functor assms show ?thesis
unfolding cf_Hom_fst_def by (rule bifunctor_proj_fst_is_functor)
qed
lemma (in category) cat_cf_Hom_fst_is_functor':
assumes "b ββ©β ββ¦Objβ¦" and "Ξ² = Ξ±" and "β' = op_cat β" and "π' = cat_Set Ξ±"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,b) : β' β¦β¦β©CβΞ²β π'"
using assms(1) unfolding assms(2-4) by (rule cat_cf_Hom_fst_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_is_functor'
subsubsectionβΉObject mapsβΊ
lemma (in category) cat_cf_Hom_snd_ObjMap_vsv[cat_cs_intros]:
assumes "a ββ©β ββ¦Objβ¦"
shows "vsv (Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ObjMapβ¦)"
unfolding cf_Hom_snd_def
using category_axioms assms
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_ObjMap_vsv
lemma (in category) cat_cf_Hom_fst_ObjMap_vsv[cat_cs_intros]:
assumes "b ββ©β ββ¦Objβ¦"
shows "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ObjMapβ¦)"
unfolding cf_Hom_fst_def
using category_axioms assms
by
(
cs_concl
cs_simp: cat_prod_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_ObjMap_vsv
lemma (in category) cat_cf_Hom_snd_ObjMap_vdomain[cat_cs_simps]:
assumes "a ββ©β ββ¦Objβ¦"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ObjMapβ¦) = ββ¦Objβ¦"
using category_axioms assms
unfolding cf_Hom_snd_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ObjMap_vdomain
lemma (in category) cat_cf_Hom_fst_ObjMap_vdomain[cat_cs_simps]:
assumes "b ββ©β ββ¦Objβ¦"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ObjMapβ¦) = op_cat ββ¦Objβ¦"
using category_axioms assms
unfolding cf_Hom_fst_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ObjMap_vdomain
lemma (in category) cat_cf_Hom_snd_ObjMap_app[cat_cs_simps]:
assumes "a ββ©β op_cat ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ObjMapβ¦β¦bβ¦ = Hom β a b"
proof-
from assms have ab: "[a, b]β©β ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
by (intro cat_prod_2_ObjI) (auto intro: cat_cs_intros)
show ?thesis
unfolding
cf_Hom_snd_def
bifunctor_proj_snd_ObjMap_app[OF category_op category_axioms ab]
cf_Hom_ObjMap_app[OF ab]
..
qed
lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ObjMap_app
lemma (in category) cat_cf_Hom_fst_ObjMap_app[cat_cs_simps]:
assumes "b ββ©β ββ¦Objβ¦" and "a ββ©β op_cat ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ObjMapβ¦β¦aβ¦ = Hom β a b"
proof-
from assms have ab: "[a, b]β©β ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
by (intro cat_prod_2_ObjI) (auto intro: cat_cs_intros)
show ?thesis
unfolding
cf_Hom_fst_def
bifunctor_proj_fst_ObjMap_app[OF category_op category_axioms ab]
cf_Hom_ObjMap_app[OF ab]
..
qed
lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ObjMap_app
subsubsectionβΉArrow mapsβΊ
lemma (in category) cat_cf_Hom_snd_ArrMap_vsv[cat_cs_intros]:
assumes "a ββ©β op_cat ββ¦Objβ¦"
shows "vsv (Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ArrMapβ¦)"
unfolding cf_Hom_snd_def
using category_axioms assms
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: bifunctor_proj_snd_ArrMap_vsv cat_cs_intros cat_op_intros
)
lemmas [cat_cs_intros] = category.cat_cf_Hom_snd_ArrMap_vsv
lemma (in category) cat_cf_Hom_fst_ArrMap_vsv[cat_cs_intros]:
assumes "b ββ©β ββ¦Objβ¦"
shows "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ArrMapβ¦)"
unfolding cf_Hom_fst_def
using category_axioms assms
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: bifunctor_proj_fst_ArrMap_vsv cat_cs_intros cat_op_intros
)
lemmas [cat_cs_intros] = category.cat_cf_Hom_fst_ArrMap_vsv
lemma (in category) cat_cf_Hom_snd_ArrMap_vdomain[cat_cs_simps]:
assumes "a ββ©β op_cat ββ¦Objβ¦"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ArrMapβ¦) = ββ¦Arrβ¦"
using category_axioms assms
unfolding cf_Hom_snd_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ArrMap_vdomain
lemma (in category) cat_cf_Hom_fst_ArrMap_vdomain[cat_cs_simps]:
assumes "b ββ©β ββ¦Objβ¦"
shows "πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ArrMapβ¦) = op_cat ββ¦Arrβ¦"
using category_axioms assms
unfolding cf_Hom_fst_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ArrMap_vdomain
lemma (in category) cat_cf_Hom_snd_ArrMap_app[cat_cs_simps]:
assumes "a ββ©β op_cat ββ¦Objβ¦" and "f : b β¦βββ b'"
shows "Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ArrMapβ¦β¦fβ¦ = cf_hom β [op_cat ββ¦CIdβ¦β¦aβ¦, f]β©β"
proof-
from assms(2) have f: "f ββ©β ββ¦Arrβ¦" by (simp add: cat_cs_intros)
from category_axioms assms show ?thesis
unfolding
cf_Hom_snd_def
bifunctor_proj_snd_ArrMap_app[OF category_op category_axioms assms(1) f]
cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_cf_Hom_snd_ArrMap_app
lemma (in category) cat_cf_Hom_fst_ArrMap_app[cat_cs_simps]:
assumes "b ββ©β ββ¦Objβ¦" and "f : a β¦βop_cat ββ a'"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ArrMapβ¦β¦fβ¦ = cf_hom β [f, ββ¦CIdβ¦β¦bβ¦]β©β"
proof-
from assms(2) have f: "f ββ©β op_cat ββ¦Arrβ¦" by (simp add: cat_cs_intros)
with category_axioms assms show ?thesis
unfolding
cf_Hom_fst_def
bifunctor_proj_fst_ArrMap_app[OF category_op category_axioms assms(1) f]
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_cf_Hom_fst_ArrMap_app
subsubsectionβΉOpposite βΉHomβΊ-functor projectionsβΊ
lemma (in category) cat_op_cat_cf_Hom_snd:
assumes "a ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±βop_cat β(a,-) = Homβ©Oβ©.β©CβΞ±ββ(-,a)"
proof(rule cf_eqI[of Ξ±])
from assms category_axioms show
"Homβ©Oβ©.β©CβΞ±βop_cat β(a,-) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from assms category_axioms show
"Homβ©Oβ©.β©CβΞ±ββ(-,a) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
show "Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ObjMapβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ObjMapβ¦"
proof(rule vsv_eqI)
from assms category_axioms show "vsv (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ObjMapβ¦)"
by (intro is_functor.cf_ObjMap_vsv)
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from assms category_axioms show "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ObjMapβ¦)"
by (intro is_functor.cf_ObjMap_vsv)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show
"πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ObjMapβ¦) = πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ObjMapβ¦)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
show "Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ObjMapβ¦β¦bβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ObjMapβ¦β¦bβ¦"
if "b ββ©β πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ObjMapβ¦)" for b
proof-
from that have "b ββ©β ββ¦Objβ¦"
by
(
simp add:
category.cat_cf_Hom_snd_ObjMap_vdomain[
OF category_op, unfolded cat_op_simps, OF assms
]
)
from category_axioms assms this show ?thesis
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
qed
qed
show "Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ArrMapβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ArrMapβ¦"
proof(rule vsv_eqI)
from assms category_axioms show "vsv (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ArrMapβ¦)"
by (intro is_functor.cf_ArrMap_vsv)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)
from assms category_axioms show "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ArrMapβ¦)"
by (intro is_functor.cf_ArrMap_vsv)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show
"πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ArrMapβ¦) = πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ArrMapβ¦)"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_op_intros)
show "Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ArrMapβ¦β¦fβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ArrMapβ¦β¦fβ¦"
if "f ββ©β πβ©β (Homβ©Oβ©.β©CβΞ±βop_cat β(a,-)β¦ArrMapβ¦)" for f
proof-
from that have "f ββ©β ββ¦Arrβ¦"
by
(
simp add:
category.cat_cf_Hom_snd_ArrMap_vdomain[
OF category_op, unfolded cat_op_simps, OF assms
]
)
then obtain a b where "f : a β¦βββ b" by auto
from category_axioms assms this show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed
qed simp_all
lemmas [cat_op_simps] = category.cat_op_cat_cf_Hom_snd
lemma (in category) cat_op_cat_cf_Hom_fst:
assumes "a ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±βop_cat β(-,a) = Homβ©Oβ©.β©CβΞ±ββ(a,-)"
proof-
from assms have a: "a ββ©β op_cat ββ¦Objβ¦" unfolding cat_op_simps .
have "Homβ©Oβ©.β©CβΞ±ββ(a,-) = Homβ©Oβ©.β©CβΞ±βop_cat (op_cat β)(a,-)"
unfolding cat_op_simps ..
also have "β¦ = Homβ©Oβ©.β©CβΞ±β(op_cat β)(-,a)"
unfolding category.cat_op_cat_cf_Hom_snd[OF category_op a] by simp
finally show "Homβ©Oβ©.β©CβΞ±β(op_cat β)(-,a) = Homβ©Oβ©.β©CβΞ±ββ(a,-)" by simp
qed
lemmas [cat_op_simps] = category.cat_op_cat_cf_Hom_fst
subsubsectionβΉβΉHomβΊ-functors are injections on objectsβΊ
lemma (in category) cat_cf_Hom_snd_inj:
assumes "Homβ©Oβ©.β©CβΞ±ββ(a,-) = Homβ©Oβ©.β©CβΞ±ββ(b,-)"
and "a ββ©β ββ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
shows "a = b"
proof(rule ccontr)
assume prems: "a β b"
from assms(1) have "Homβ©Oβ©.β©CβΞ±ββ(a,-)β¦ObjMapβ¦β¦bβ¦ = Homβ©Oβ©.β©CβΞ±ββ(b,-)β¦ObjMapβ¦β¦bβ¦"
by simp
then have "Hom β a b = Hom β b b"
unfolding
cat_cf_Hom_snd_ObjMap_app[unfolded cat_op_simps, OF assms(2,3)]
cat_cf_Hom_snd_ObjMap_app[unfolded cat_op_simps, OF assms(3,3)]
by simp
with assms prems show False by (force intro: cat_cs_intros)
qed
lemma (in category) cat_cf_Hom_fst_inj:
assumes "Homβ©Oβ©.β©CβΞ±ββ(-,a) = Homβ©Oβ©.β©CβΞ±ββ(-,b)" and "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "a = b"
proof(rule ccontr)
assume prems: "a β b"
from assms(1) have "Homβ©Oβ©.β©CβΞ±ββ(-,a)β¦ObjMapβ¦β¦bβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,b)β¦ObjMapβ¦β¦bβ¦"
by simp
then have "Hom β b a = Hom β b b"
unfolding
cat_cf_Hom_fst_ObjMap_app[unfolded cat_op_simps, OF assms(2,3)]
cat_cf_Hom_fst_ObjMap_app[unfolded cat_op_simps, OF assms(3,3)]
by simp
with assms prems show False by (force intro: cat_cs_intros)
qed
subsubsectionβΉβΉHomβΊ-functor is an array bifunctorβΊ
lemma (in category) cat_cf_Hom_is_cf_array:
"Homβ©Oβ©.β©CβΞ±ββ(-,-) =
cf_array (op_cat β) β (cat_Set Ξ±) (cf_Hom_fst Ξ± β) (cf_Hom_snd Ξ± β)"
proof(rule cf_eqI[of Ξ±])
show "Homβ©Oβ©.β©CβΞ±ββ(-,-) : op_cat β Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule cat_Hom_is_functor)
have c1: "category Ξ± (op_cat β)" by (auto intro: cat_cs_intros)
have c2: "category Ξ± β" by (auto intro: cat_cs_intros)
have c3: "category Ξ± (cat_Set Ξ±)" by (simp add: category_cat_Set)
have c4: "Homβ©Oβ©.β©CβΞ±ββ(-,c) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
if "c ββ©β ββ¦Objβ¦" for c
using that by (rule cat_cf_Hom_fst_is_functor)
have c5: "Homβ©Oβ©.β©CβΞ±ββ(b,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
if "b ββ©β op_cat ββ¦Objβ¦" for b
using that unfolding cat_op_simps by (rule cat_cf_Hom_snd_is_functor)
have c6: "Homβ©Oβ©.β©CβΞ±ββ(b,-)β¦ObjMapβ¦β¦cβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,c)β¦ObjMapβ¦β¦bβ¦"
if "b ββ©β op_cat ββ¦Objβ¦" and "c ββ©β ββ¦Objβ¦" for b c
using that category_axioms
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have c7:
"Homβ©Oβ©.β©CβΞ±ββ(b',-)β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(-,c)β¦ArrMapβ¦β¦fβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,c' )β¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(b,- )β¦ArrMapβ¦β¦gβ¦"
if "f : b β¦βop_cat ββ b'" and "g : c β¦βββ c'" for b c b' c' f g
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
let ?cfa =
βΉcf_array (op_cat β) β (cat_Set Ξ±) (cf_Hom_fst Ξ± β) (cf_Hom_snd Ξ± β)βΊ
note cf_array_specification =
cf_array_specification[OF c1 c2 c3 c4 c5 c6 c7, simplified]
from c1 c2 c3 c4 c5 c6 c7 show "?cfa : op_cat β Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule cf_array_is_functor)
show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦ = ?cfaβ¦ObjMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps)
fix aa' assume "aa' ββ©β (op_cat β Γβ©C β)β¦Objβ¦"
then obtain a a'
where aa'_def: "aa' = [a, a']β©β"
and a: "a ββ©β op_cat ββ¦Objβ¦"
and a': "a' ββ©β ββ¦Objβ¦"
by (elim cat_prod_2_ObjE[OF c1 c2])
from category_axioms a a' show
"Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ObjMapβ¦β¦aa'β¦ = ?cfaβ¦ObjMapβ¦β¦aa'β¦"
unfolding aa'_def cf_array_specification(2)[OF a a'] cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_op_intros cat_prod_cs_intros
)
qed (auto simp: cf_array_ObjMap_vsv cf_Hom_ObjMap_vsv cat_cs_simps)
show "Homβ©Oβ©.β©CβΞ±ββ(-,-)β¦ArrMapβ¦ = ?cfaβ¦ArrMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps)
fix ff' assume "ff' ββ©β (op_cat β Γβ©C β)β¦Arrβ¦"
then obtain f f'
where ff'_def: "ff' = [f, f']β©β"
and f: "f ββ©β op_cat ββ¦Arrβ¦"
and f': "f' ββ©β ββ¦Arrβ¦"
by (elim cat_prod_2_ArrE[OF c1 c2])
then obtain a b a' b'
where f: "f : a β¦βop_cat ββ b" and f': "f' : a' β¦βββ b'"
by (blast intro: is_arrI)
from category_axioms f f' show "cf_hom β ff' = ?cfaβ¦ArrMapβ¦β¦ff'β¦"
unfolding ff'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: cf_array_ArrMap_vsv cf_Hom_ArrMap_vsv cat_cs_simps)
qed simp_all
subsubsectionβΉ
Projections of the compositions of a βΉHomβΊ-functor and a functor are
projections of the βΉHomβΊ-functor
βΊ
lemma (in category) cat_cf_rcomp_Hom_cf_Hom_snd:
assumes "π : π
β¦β¦β©CβΞ±β β" and "a ββ©β ββ¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(a,-)β©Cβ©F = Homβ©Oβ©.β©CβΞ±ββ(a,-) ββ©Cβ©F π"
using category_axioms assms
unfolding cf_rcomp_Hom_def cf_Hom_snd_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_rcomp_Hom_cf_Hom_snd
lemma (in category) cat_cf_lcomp_Hom_cf_Hom_snd:
assumes "π : π
β¦β¦β©CβΞ±β β" and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-)βop_cat π
,ββ(b,-)β©Cβ©F = Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-)"
using category_axioms assms
unfolding cf_lcomp_Hom_def cf_Hom_snd_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
lemmas [cat_cs_simps] = category.cat_cf_lcomp_Hom_cf_Hom_snd
lemma (in category) cat_cf_rcomp_Hom_cf_Hom_fst:
assumes "π : π
β¦β¦β©CβΞ±β β" and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F = Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)"
proof-
from category_axioms assms have Hπb:
"Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from category_axioms assms have Hπb':
"Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from category_axioms assms have [cat_cs_simps]:
"πβ©β ((Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦) = op_cat ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
from category_axioms assms have [cat_cs_simps]:
"πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ObjMapβ¦) = op_cat ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms have [cat_cs_simps]:
"πβ©β ((Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦) = op_cat ββ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
from category_axioms assms have [cat_cs_simps]:
"πβ©β (Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ArrMapβ¦) = op_cat ββ¦Arrβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(rule cf_eqI[OF Hπb Hπb'])
show
"(Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ObjMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps)
from category_axioms assms show
"vsv ((Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦)"
by (intro bifunctor_proj_fst_ObjMap_vsv[of Ξ±])
(cs_concl cs_intro: cat_cs_intros)+
from assms show "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ObjMapβ¦)"
by (intro cat_cf_Hom_fst_ObjMap_vsv)
(cs_concl cs_intro: cat_cs_intros)+
fix a assume prems: "a ββ©β op_cat ββ¦Objβ¦"
with category_axioms assms show
"(Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ObjMapβ¦β¦aβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ObjMapβ¦β¦aβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed simp
show
"(Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ArrMapβ¦"
proof(rule vsv_eqI, unfold cat_cs_simps cat_op_simps)
from category_axioms assms show
"vsv ((Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦)"
by (intro bifunctor_proj_fst_ArrMap_vsv[of Ξ±])
(cs_concl cs_intro: cat_cs_intros)+
from assms show "vsv (Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ArrMapβ¦)"
by (intro cat_cf_Hom_fst_ArrMap_vsv)
(cs_concl cs_intro: cat_cs_intros)+
fix f assume "f ββ©β ββ¦Arrβ¦"
then obtain a' b' where "f : a' β¦βββ b'" by (auto simp: cat_op_simps)
from category_axioms assms this show
"(Homβ©Oβ©.β©CβΞ±ββ(-,π-)βop_cat β,π
β(-,b)β©Cβ©F)β¦ArrMapβ¦β¦fβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(-,πβ¦ObjMapβ¦β¦bβ¦)β¦ArrMapβ¦β¦fβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed simp
qed simp_all
qed
lemmas [cat_cs_simps] = category.cat_cf_rcomp_Hom_cf_Hom_fst
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Yoneda
sectionβΉYoneda LemmaβΊ
theory CZH_ECAT_Yoneda
imports
CZH_ECAT_FUNCT
CZH_ECAT_Hom
begin
subsectionβΉYoneda mapβΊ
textβΉ
The Yoneda map is the bijection that is used in the statement of the
Yoneda Lemma, as presented, for example, in Chapter III-2 in
\cite{mac_lane_categories_2010} or in subsection 1.15
in \cite{bodo_categories_1970}.
βΊ
definition Yoneda_map :: "V β V β V β V"
where "Yoneda_map Ξ± π r =
(
Ξ»Οββ©βthese_ntcfs Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(r,-) π.
Οβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦πβ¦HomDomβ¦β¦CIdβ¦β¦rβ¦β¦
)"
textβΉElementary properties.βΊ
mk_VLambda Yoneda_map_def
|vsv Yoneda_map_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) Yoneda_map_def[where Ξ±=Ξ± and π=π, unfolded cf_HomDom]
|vdomain Yoneda_map_vdomain|
|app Yoneda_map_app[unfolded these_ntcfs_iff]|
lemmas [cat_cs_simps] = is_functor.Yoneda_map_vdomain
lemmas Yoneda_map_app[cat_cs_simps] =
is_functor.Yoneda_map_app[unfolded these_ntcfs_iff]
subsectionβΉYoneda componentβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The Yoneda components are the components of the natural transformations
that appear in the statement of the Yoneda Lemma (e.g., see
Chapter III-2 in \cite{mac_lane_categories_2010} or subsection 1.15
in \cite{bodo_categories_1970}).
βΊ
definition Yoneda_component :: "V β V β V β V β V"
where "Yoneda_component π r u d =
[
(Ξ»fββ©βHom (πβ¦HomDomβ¦) r d. πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦uβ¦),
Hom (πβ¦HomDomβ¦) r d,
πβ¦ObjMapβ¦β¦dβ¦
]β©β"
textβΉComponents.βΊ
lemma (in is_functor) Yoneda_component_components:
shows "Yoneda_component π r u dβ¦ArrValβ¦ =
(Ξ»fββ©βHom π r d. πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦uβ¦)"
and "Yoneda_component π r u dβ¦ArrDomβ¦ = Hom π r d"
and "Yoneda_component π r u dβ¦ArrCodβ¦ = πβ¦ObjMapβ¦β¦dβ¦"
unfolding Yoneda_component_def arr_field_simps
by (simp_all add: nat_omega_simps cat_cs_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda (in is_functor) Yoneda_component_components(1)
|vsv Yoneda_component_ArrVal_vsv|
|vdomain Yoneda_component_ArrVal_vdomain|
|app Yoneda_component_ArrVal_app[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] = is_functor.Yoneda_component_ArrVal_vdomain
lemmas Yoneda_component_ArrVal_app[cat_cs_simps] =
is_functor.Yoneda_component_ArrVal_app[unfolded in_Hom_iff]
subsubsectionβΉYoneda component is an arrow in the category βΉSetβΊβΊ
lemma (in category) cat_Yoneda_component_is_arr:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
and "u ββ©β πβ¦ObjMapβ¦β¦rβ¦"
and "d ββ©β ββ¦Objβ¦"
shows "Yoneda_component π r u d : Hom β r d β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦dβ¦"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(1))
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI, unfold π.Yoneda_component_components)
show "vfsequence (Yoneda_component π r u d)"
unfolding Yoneda_component_def by simp
show "vcard (Yoneda_component π r u d) = 3β©β"
unfolding Yoneda_component_def by (simp add: nat_omega_simps)
show "ββ©β (Ξ»fββ©βHom β r d. πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦uβ¦) ββ©β πβ¦ObjMapβ¦β¦dβ¦"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ββ©β Hom β r d"
then have πf: "πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦rβ¦ β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦dβ¦"
by (auto simp: cat_cs_intros)
note πf_simps = cat_Set_is_arrD[OF πf]
interpret πf: arr_Set Ξ± βΉπβ¦ArrMapβ¦β¦fβ¦βΊ by (rule πf_simps(1))
have "u ββ©β πβ©β (πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦)"
by (simp add: πf_simps assms cat_Set_cs_simps)
with πf.arr_Set_ArrVal_vrange[unfolded πf_simps] show
"πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦uβ¦ ββ©β πβ¦ObjMapβ¦β¦dβ¦"
by (blast elim: πf.ArrVal.vsv_value)
qed
from assms π.HomCod.cat_Obj_vsubset_Vset show "πβ¦ObjMapβ¦β¦dβ¦ ββ©β Vset Ξ±"
by (auto dest: π.cf_ObjMap_app_in_HomCod_Obj)
qed (auto simp: assms cat_cs_intros)
qed
lemma (in category) cat_Yoneda_component_is_arr':
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
and "u ββ©β πβ¦ObjMapβ¦β¦rβ¦"
and "d ββ©β ββ¦Objβ¦"
and "s = Hom β r d"
and "t = πβ¦ObjMapβ¦β¦dβ¦"
and "π = cat_Set Ξ±"
shows "Yoneda_component π r u d : s β¦βπβ t"
unfolding assms(5-7) using assms(1-4) by (rule cat_Yoneda_component_is_arr)
lemmas [cat_cs_intros] = category.cat_Yoneda_component_is_arr'[rotated 1]
subsectionβΉYoneda arrowβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The Yoneda arrows are the natural transformations that
appear in the statement of the Yoneda Lemma in Chapter III-2 in
\cite{mac_lane_categories_2010} and subsection 1.15
in \cite{bodo_categories_1970}.
βΊ
definition Yoneda_arrow :: "V β V β V β V β V"
where "Yoneda_arrow Ξ± π r u =
[
(Ξ»dββ©βπβ¦HomDomβ¦β¦Objβ¦. Yoneda_component π r u d),
Homβ©Oβ©.β©CβΞ±βπβ¦HomDomβ¦(r,-),
π,
πβ¦HomDomβ¦,
cat_Set Ξ±
]β©β"
textβΉComponents.βΊ
lemma (in is_functor) Yoneda_arrow_components:
shows "Yoneda_arrow Ξ± π r uβ¦NTMapβ¦ =
(Ξ»dββ©βπβ¦Objβ¦. Yoneda_component π r u d)"
and "Yoneda_arrow Ξ± π r uβ¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±βπ(r,-)"
and "Yoneda_arrow Ξ± π r uβ¦NTCodβ¦ = π"
and "Yoneda_arrow Ξ± π r uβ¦NTDGDomβ¦ = π"
and "Yoneda_arrow Ξ± π r uβ¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding Yoneda_arrow_def nt_field_simps
by (simp_all add: nat_omega_simps cat_cs_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda (in is_functor) Yoneda_arrow_components(1)
|vsv Yoneda_arrow_NTMap_vsv|
|vdomain Yoneda_arrow_NTMap_vdomain|
|app Yoneda_arrow_NTMap_app|
lemmas [cat_cs_simps] = is_functor.Yoneda_arrow_NTMap_vdomain
lemmas Yoneda_arrow_NTMap_app[cat_cs_simps] =
is_functor.Yoneda_arrow_NTMap_app
subsubsectionβΉYoneda arrow is a natural transformationβΊ
lemma (in category) cat_Yoneda_arrow_is_ntcf:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
and "u ββ©β πβ¦ObjMapβ¦β¦rβ¦"
shows "Yoneda_arrow Ξ± π r u : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(1))
note πru = cat_Yoneda_component_is_arr[OF assms]
let ?πru = βΉYoneda_component π r uβΊ
show ?thesis
proof(intro is_ntcfI', unfold π.Yoneda_arrow_components)
show "vfsequence (Yoneda_arrow Ξ± π r u)"
unfolding Yoneda_arrow_def by simp
show "vcard (Yoneda_arrow Ξ± π r u) = 5β©β"
unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)
show
"(Ξ»dββ©βββ¦Objβ¦. ?πru d)β¦aβ¦ :
Homβ©Oβ©.β©CβΞ±ββ(r,-)β¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦aβ¦"
if "a ββ©β ββ¦Objβ¦" for a
using that assms category_axioms
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps V_cs_simps
cs_intro: cat_cs_intros
)
show
"(Ξ»dββ©βββ¦Objβ¦. ?πru d)β¦bβ¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(r,-)β¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β (Ξ»dββ©βββ¦Objβ¦. ?πru d)β¦aβ¦"
if "f : a β¦βββ b" for a b f
proof-
note πa = πru[OF cat_is_arrD(2)[OF that]]
note πb = πru[OF cat_is_arrD(3)[OF that]]
from category_axioms assms that πb have b_f:
"?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β :
Hom β r a β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦bβ¦"
by
(
cs_concl cs_intro:
cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"πβ©β ((?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β)β¦ArrValβ¦) =
Hom β r a"
by (cs_concl cs_simp: cat_cs_simps)
from assms that πa have f_a:
"πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a :
Hom β r a β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_intro: cat_cs_intros)
then have dom_rhs:
"πβ©β ((πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a)β¦ArrValβ¦) = Hom β r a"
by (cs_concl cs_simp: cat_cs_simps)
have [cat_cs_simps]:
"?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a"
proof(rule arr_Set_eqI[of Ξ±])
from b_f show arr_Set_b_f:
"arr_Set Ξ± (?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β)"
by (auto simp: cat_Set_is_arrD(1))
interpret b_f: arr_Set Ξ± βΉ?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©ββΊ
by (rule arr_Set_b_f)
from f_a show arr_Set_f_a:
"arr_Set Ξ± (πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a)"
by (auto simp: cat_Set_is_arrD(1))
interpret f_a: arr_Set Ξ± βΉπβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru aβΊ
by (rule arr_Set_f_a)
show
"(?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β)β¦ArrValβ¦ =
(πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix q assume "q : r β¦βββ a"
from category_axioms assms that this πa πb show
"(?πru b ββ©Aβcat_Set Ξ±β cf_hom β [ββ¦CIdβ¦β¦rβ¦, f]β©β)β¦ArrValβ¦β¦qβ¦ =
(πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β ?πru a)β¦ArrValβ¦β¦qβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_b_f arr_Set_f_a in auto)
qed (use b_f f_a in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
from that category_axioms assms πa πb show ?thesis
by
(
cs_concl
cs_simp: V_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
qed
qed (auto simp: assms(2) cat_cs_intros)
qed
subsectionβΉYoneda LemmaβΊ
textβΉ
The following lemma is approximately equivalent to the Yoneda Lemma
stated in subsection 1.15 in \cite{bodo_categories_1970}
(the first two conclusions correspond to the statement of the
Yoneda lemma in Chapter III-2 in \cite{mac_lane_categories_2010}).
βΊ
lemma (in category) cat_Yoneda_Lemma:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "r ββ©β ββ¦Objβ¦"
shows "v11 (Yoneda_map Ξ± π r)"
and "ββ©β (Yoneda_map Ξ± π r) = πβ¦ObjMapβ¦β¦rβ¦"
and "(Yoneda_map Ξ± π r)Β―β©β = (Ξ»uββ©βπβ¦ObjMapβ¦β¦rβ¦. Yoneda_arrow Ξ± π r u)"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(1))
from assms(2) π.HomCod.cat_Obj_vsubset_Vset π.cf_ObjMap_app_in_HomCod_Obj
have πr_in_Vset: "πβ¦ObjMapβ¦β¦rβ¦ ββ©β Vset Ξ±"
by auto
show Ym: "v11 (Yoneda_map Ξ± π r)"
proof(intro vsv.vsv_valeq_v11I, unfold π.Yoneda_map_vdomain these_ntcfs_iff)
fix π π
assume prems:
"π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
"π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
"Yoneda_map Ξ± π rβ¦πβ¦ = Yoneda_map Ξ± π rβ¦πβ¦"
from prems(3) have πr_πr:
"πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦ = πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦"
unfolding
Yoneda_map_app[OF assms(1) prems(1)]
Yoneda_map_app[OF assms(1) prems(2)]
by simp
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(r,-)βΊ π π
by (rule prems(1))
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(r,-)βΊ π π
by (rule prems(2))
show "π = π"
proof
(
rule ntcf_eqI[OF prems(1,2)];
(rule refl)?;
rule vsv_eqI,
unfold π.ntcf_NTMap_vdomain π.ntcf_NTMap_vdomain
)
fix d assume prems': "d ββ©β ββ¦Objβ¦"
note πd_simps = cat_Set_is_arrD[OF π.ntcf_NTMap_is_arr[OF prems']]
interpret πd: arr_Set Ξ± βΉπβ¦NTMapβ¦β¦dβ¦βΊ by (rule πd_simps(1))
note πd_simps = cat_Set_is_arrD[OF π.ntcf_NTMap_is_arr[OF prems']]
interpret πd: arr_Set Ξ± βΉπβ¦NTMapβ¦β¦dβ¦βΊ by (rule πd_simps(1))
show "πβ¦NTMapβ¦β¦dβ¦ = πβ¦NTMapβ¦β¦dβ¦"
proof(rule arr_Set_eqI[of Ξ±])
show "πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦ = πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦"
proof
(
rule vsv_eqI,
unfold
πd.arr_Set_ArrVal_vdomain
πd.arr_Set_ArrVal_vdomain
πd_simps
πd_simps
)
fix f assume prems'': "f ββ©β Homβ©Oβ©.β©CβΞ±ββ(r,-)β¦ObjMapβ¦β¦dβ¦"
from prems'' prems' category_axioms assms(2) have f: "f : r β¦βββ d"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_op_intros)
from π.ntcf_Comp_commute[OF f] have
"(
πβ¦NTMapβ¦β¦dβ¦ ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(r,-)β¦ArrMapβ¦β¦fβ¦
)β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦ =
(πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β πβ¦NTMapβ¦β¦rβ¦)β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦"
by simp
from this category_axioms assms(2) f prems prems' have πdf:
"πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from π.ntcf_Comp_commute[OF f] have
"(
πβ¦NTMapβ¦β¦dβ¦ ββ©Aβcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±ββ(r,-)β¦ArrMapβ¦β¦fβ¦
)β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦ =
(πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβcat_Set Ξ±β πβ¦NTMapβ¦β¦rβ¦)β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦"
by simp
from this category_axioms assms(2) f prems prems' have πdf:
"πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
show "πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦β¦fβ¦ = πβ¦NTMapβ¦β¦dβ¦β¦ArrValβ¦β¦fβ¦"
unfolding πdf πdf πr_πr by simp
qed auto
qed (simp_all add: πd_simps πd_simps)
qed auto
qed (auto simp: Yoneda_map_vsv)
interpret Ym: v11 βΉYoneda_map Ξ± π rβΊ by (rule Ym)
have YY: "Yoneda_map Ξ± π rβ¦Yoneda_arrow Ξ± π r aβ¦ = a"
if "a ββ©β πβ¦ObjMapβ¦β¦rβ¦" for a
proof-
note cat_Yoneda_arrow_is_ntcf[OF assms that]
moreover with assms have Ya: "Yoneda_arrow Ξ± π r a ββ©β πβ©β (Yoneda_map Ξ± π r)"
by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "Yoneda_map Ξ± π rβ¦Yoneda_arrow Ξ± π r aβ¦ = a"
using assms that πr_in_Vset
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
show [simp]: "ββ©β (Yoneda_map Ξ± π r) = πβ¦ObjMapβ¦β¦rβ¦"
proof(intro vsubset_antisym)
show "ββ©β (Yoneda_map Ξ± π r) ββ©β πβ¦ObjMapβ¦β¦rβ¦"
unfolding Yoneda_map_def
proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff π.cf_HomDom)
fix π assume prems: "π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
then interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(r,-)βΊ π π .
note πr_simps = cat_Set_is_arrD[OF π.ntcf_NTMap_is_arr[OF assms(2)]]
interpret πr: arr_Set Ξ± βΉπβ¦NTMapβ¦β¦rβ¦βΊ by (rule πr_simps(1))
from prems category_axioms assms(2) have
"ββ¦CIdβ¦β¦rβ¦ ββ©β πβ©β (πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦)"
unfolding πr.arr_Set_ArrVal_vdomain πr_simps
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
then have "πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦ ββ©β ββ©β (πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦)"
by (blast elim: πr.ArrVal.vsv_value)
then show "πβ¦NTMapβ¦β¦rβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦rβ¦β¦ ββ©β πβ¦ObjMapβ¦β¦rβ¦"
by (auto simp: πr_simps dest!: vsubsetD[OF πr.arr_Set_ArrVal_vrange])
qed
show "πβ¦ObjMapβ¦β¦rβ¦ ββ©β ββ©β (Yoneda_map Ξ± π r)"
proof(intro vsubsetI)
fix u assume prems: "u ββ©β πβ¦ObjMapβ¦β¦rβ¦"
from cat_Yoneda_arrow_is_ntcf[OF assms prems] have
"Yoneda_arrow Ξ± π r u ββ©β πβ©β (Yoneda_map Ξ± π r)"
by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
with YY[OF prems] show "u ββ©β ββ©β (Yoneda_map Ξ± π r)"
by (force dest!: vdomain_atD)
qed
qed
show "(Yoneda_map Ξ± π r)Β―β©β = (Ξ»uββ©βπβ¦ObjMapβ¦β¦rβ¦. Yoneda_arrow Ξ± π r u)"
proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
from Ym show "vsv ((Yoneda_map Ξ± π r)Β―β©β)" by auto
show "(Yoneda_map Ξ± π r)Β―β©ββ¦aβ¦ = (Ξ»uββ©βπβ¦ObjMapβ¦β¦rβ¦. Yoneda_arrow Ξ± π r u)β¦aβ¦"
if "a ββ©β ββ©β (Yoneda_map Ξ± π r)" for a
proof-
from that have a: "a ββ©β πβ¦ObjMapβ¦β¦rβ¦" by simp
note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
then have "Yoneda_arrow Ξ± π r a ββ©β πβ©β (Yoneda_map Ξ± π r)"
by
(
cs_concl
cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
)
with Ya YY[OF a] a show ?thesis
by
(
intro Ym.v11_vconverse_app[
unfolded π.Yoneda_map_vdomain these_ntcfs_iff
]
)
(simp_all add: these_ntcfs_iff cat_cs_simps)
qed
qed auto
qed
subsectionβΉInverse of the Yoneda mapβΊ
lemma (in category) inv_Yoneda_map_v11:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "r ββ©β ββ¦Objβ¦"
shows "v11 ((Yoneda_map Ξ± π r)Β―β©β)"
using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_Yoneda_map_vdomain:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "r ββ©β ββ¦Objβ¦"
shows "πβ©β ((Yoneda_map Ξ± π r)Β―β©β) = πβ¦ObjMapβ¦β¦rβ¦"
unfolding cat_Yoneda_Lemma(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_Yoneda_map_vdomain
lemma (in category) inv_Yoneda_map_app:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "r ββ©β ββ¦Objβ¦" and "u ββ©β πβ¦ObjMapβ¦β¦rβ¦"
shows "(Yoneda_map Ξ± π r)Β―β©ββ¦uβ¦ = Yoneda_arrow Ξ± π r u"
using assms(3) unfolding cat_Yoneda_Lemma(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_Yoneda_map_app
lemma (in category) inv_Yoneda_map_vrange:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "ββ©β ((Yoneda_map Ξ± π r)Β―β©β) =
these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(r,-) π"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(1))
show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
qed
subsectionβΉ
Component of a composition of a βΉHomβΊ-natural transformation
with natural transformations
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following definition is merely a technical generalization
that is used in the context of the description of the
composition of a βΉHomβΊ-natural transformation with a natural transformation
later in this section
(also see subsection 1.15 in \cite{bodo_categories_1970}).
βΊ
definition ntcf_Hom_component :: "V β V β V β V β V"
where "ntcf_Hom_component Ο Ο a b =
[
(
Ξ»fββ©βHom (Οβ¦NTDGCodβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦bβ¦).
Οβ¦NTMapβ¦β¦bβ¦ ββ©AβΟβ¦NTDGCodβ¦β f ββ©AβΟβ¦NTDGCodβ¦β Οβ¦NTMapβ¦β¦aβ¦
),
Hom (Οβ¦NTDGCodβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦bβ¦),
Hom (Οβ¦NTDGCodβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦bβ¦)
]β©β"
textβΉComponents.βΊ
lemma ntcf_Hom_component_components:
shows "ntcf_Hom_component Ο Ο a bβ¦ArrValβ¦ =
(
Ξ»fββ©βHom (Οβ¦NTDGCodβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦bβ¦).
Οβ¦NTMapβ¦β¦bβ¦ ββ©AβΟβ¦NTDGCodβ¦β f ββ©AβΟβ¦NTDGCodβ¦β Οβ¦NTMapβ¦β¦aβ¦
)"
and "ntcf_Hom_component Ο Ο a bβ¦ArrDomβ¦ =
Hom (Οβ¦NTDGCodβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦bβ¦)"
and "ntcf_Hom_component Ο Ο a bβ¦ArrCodβ¦ =
Hom (Οβ¦NTDGCodβ¦) (Οβ¦NTDomβ¦β¦ObjMapβ¦β¦aβ¦) (Οβ¦NTCodβ¦β¦ObjMapβ¦β¦bβ¦)"
unfolding ntcf_Hom_component_def arr_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda ntcf_Hom_component_components(1)
|vsv ntcf_Hom_component_ArrVal_vsv[intro]|
context
fixes Ξ± Ο Ο π π π' π' π π
β
assumes Ο: "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and Ο: "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
begin
interpretation Ο: is_ntcf Ξ± π β π π Ο by (rule Ο)
interpretation Ο: is_ntcf Ξ± π
β π' π' Ο by (rule Ο)
mk_VLambda
ntcf_Hom_component_components(1)
[
of Ο Ο,
unfolded
Ο.ntcf_NTDom Ο.ntcf_NTDom
Ο.ntcf_NTCod Ο.ntcf_NTCod
Ο.ntcf_NTDGDom Ο.ntcf_NTDGDom
Ο.ntcf_NTDGCod Ο.ntcf_NTDGCod
]
|vdomain ntcf_Hom_component_ArrVal_vdomain|
|app ntcf_Hom_component_ArrVal_app[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] =
ntcf_Hom_component_ArrVal_vdomain
ntcf_Hom_component_ArrVal_app
lemma ntcf_Hom_component_ArrVal_vrange:
assumes "a ββ©β πβ¦Objβ¦" and "b ββ©β π
β¦Objβ¦"
shows
"ββ©β (ntcf_Hom_component Ο Ο a bβ¦ArrValβ¦) ββ©β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
)
fix f assume "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ π'β¦ObjMapβ¦β¦bβ¦"
with assms Ο Ο show
"ntcf_Hom_component Ο Ο a bβ¦ArrValβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ π'β¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (rule ntcf_Hom_component_ArrVal_vsv)
end
subsubsectionβΉArrow domain and codomainβΊ
context
fixes Ξ± Ο Ο π π π' π' π π
β
assumes Ο: "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and Ο: "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
begin
interpretation Ο: is_ntcf Ξ± π β π π Ο by (rule Ο)
interpretation Ο: is_ntcf Ξ± π
β π' π' Ο by (rule Ο)
lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
"ntcf_Hom_component Ο Ο a bβ¦ArrDomβ¦ = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
"ntcf_Hom_component Ο Ο a bβ¦ArrCodβ¦ = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)
end
subsubsectionβΉ
Component of a composition of a βΉHomβΊ-natural transformation
with natural transformations is an arrow in the category βΉSetβΊ
βΊ
lemma (in category) cat_ntcf_Hom_component_is_arr:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows
"ntcf_Hom_component Ο Ο a b :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
interpret Ο: is_ntcf Ξ± π
β π' π' Ο by (rule assms(2))
from assms have a: "a ββ©β πβ¦Objβ¦" unfolding cat_op_simps by simp
show ?thesis
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (ntcf_Hom_component Ο Ο a b)"
unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
show "vcard (ntcf_Hom_component Ο Ο a b) = 3β©β"
unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
from assms ntcf_Hom_component_ArrVal_vrange[OF assms(1,2) a assms(4)] show
"ββ©β (ntcf_Hom_component Ο Ο a bβ¦ArrValβ¦) ββ©β
ntcf_Hom_component Ο Ο a bβ¦ArrCodβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms(1,2,4) a show "ntcf_Hom_component Ο Ο a bβ¦ArrDomβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(1,2,4) a show "ntcf_Hom_component Ο Ο a bβ¦ArrCodβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use assms in βΉauto simp: ntcf_Hom_component_components cat_cs_simpsβΊ)
qed
lemma (in category) cat_ntcf_Hom_component_is_arr':
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "π' = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
and "π
' = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
and "β' = cat_Set Ξ±"
shows "ntcf_Hom_component Ο Ο a b : π' β¦ββ'β π
'"
using assms(1-4) unfolding assms(5-7) by (rule cat_ntcf_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_component_is_arr'
subsubsectionβΉ
Naturality of the components of a composition of
a βΉHomβΊ-natural transformation with natural transformations
βΊ
lemma (in category) cat_ntcf_Hom_component_nat:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "g : a β¦βop_cat πβ a'"
and "f : b β¦βπ
β b'"
shows
"ntcf_Hom_component Ο Ο a' b' ββ©Aβcat_Set Ξ±β
cf_hom β [πβ¦ArrMapβ¦β¦gβ¦, π'β¦ArrMapβ¦β¦fβ¦]β©β =
cf_hom β [πβ¦ArrMapβ¦β¦gβ¦, π'β¦ArrMapβ¦β¦fβ¦]β©β ββ©Aβcat_Set Ξ±β
ntcf_Hom_component Ο Ο a b"
proof-
let ?Y_ab = βΉntcf_Hom_component Ο Ο a bβΊ
and ?Y_a'b' = βΉntcf_Hom_component Ο Ο a' b'βΊ
and ?πg = βΉπβ¦ArrMapβ¦β¦gβ¦βΊ
and ?π'f = βΉπ'β¦ArrMapβ¦β¦fβ¦βΊ
and ?πg = βΉπβ¦ArrMapβ¦β¦gβ¦βΊ
and ?π'f = βΉπ'β¦ArrMapβ¦β¦fβ¦βΊ
and ?πa = βΉπβ¦ObjMapβ¦β¦aβ¦βΊ
and ?π'b = βΉπ'β¦ObjMapβ¦β¦bβ¦βΊ
and ?πa' = βΉπβ¦ObjMapβ¦β¦a'β¦βΊ
and ?π'b' = βΉπ'β¦ObjMapβ¦β¦b'β¦βΊ
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
interpret Ο: is_ntcf Ξ± π
β π' π' Ο by (rule assms(2))
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
from assms(3) have g: "g : a' β¦βπβ a" unfolding cat_op_simps by simp
from Set.category_axioms category_axioms assms g have a'b_Ggπ'f:
"?Y_a'b' ββ©Aβcat_Set Ξ±β cf_hom β [?πg, ?π'f]β©β :
Hom β ?πa ?π'b β¦βcat_Set Ξ±β Hom β ?πa' ?π'b'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"πβ©β ((?Y_a'b' ββ©Aβcat_Set Ξ±β cf_hom β [?πg, ?π'f]β©β)β¦ArrValβ¦) =
Hom β ?πa ?π'b"
by (cs_concl cs_simp: cat_cs_simps)
from Set.category_axioms category_axioms assms g have πgπ'f_ab:
"cf_hom β [?πg, ?π'f]β©β ββ©Aβcat_Set Ξ±β ?Y_ab :
Hom β ?πa ?π'b β¦βcat_Set Ξ±β Hom β ?πa' ?π'b'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_rhs:
"πβ©β ((cf_hom β [?πg, ?π'f]β©β ββ©Aβcat_Set Ξ±β ?Y_ab)β¦ArrValβ¦) =
Hom β ?πa ?π'b"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from a'b_Ggπ'f show arr_Set_a'b_Ggπ'f:
"arr_Set Ξ± (?Y_a'b' ββ©Aβcat_Set Ξ±β cf_hom β [?πg, ?π'f]β©β)"
by (auto dest: cat_Set_is_arrD(1))
from πgπ'f_ab show arr_Set_πgπ'f_ab:
"arr_Set Ξ± (cf_hom β [?πg, ?π'f]β©β ββ©Aβcat_Set Ξ±β ?Y_ab)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?Y_a'b' ββ©Aβcat_Set Ξ±β cf_hom β [?πg, ?π'f]β©β)β¦ArrValβ¦ =
(cf_hom β [?πg, ?π'f]β©β ββ©Aβcat_Set Ξ±β ?Y_ab)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume prems: "h : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ π'β¦ObjMapβ¦β¦bβ¦"
from assms(1,2) g have [cat_cs_simps]:
"Οβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ (?π'f ββ©Aβββ (h ββ©Aβββ (?πg ββ©Aβββ Οβ¦NTMapβ¦β¦a'β¦))) =
Οβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ (?π'f ββ©Aβββ (h ββ©Aβββ (Οβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ ?πg)))"
by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
also from assms(1,2,4) prems g have "β¦ =
(((Οβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ ?π'f) ββ©Aβββ h) ββ©Aβββ Οβ¦NTMapβ¦β¦aβ¦) ββ©Aβββ ?πg"
by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros)
also from assms(1,2,4) have "β¦ =
(((?π'f ββ©Aβββ Οβ¦NTMapβ¦β¦bβ¦) ββ©Aβββ h) ββ©Aβββ Οβ¦NTMapβ¦β¦aβ¦) ββ©Aβββ ?πg"
by (cs_concl cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros)
also from assms(1,2,4) prems g have "β¦ =
?π'f ββ©Aβββ (Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ (h ββ©Aβββ (Οβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ ?πg)))"
by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros)
finally have nat:
"Οβ¦NTMapβ¦β¦b'β¦ ββ©Aβββ (?π'f ββ©Aβββ (h ββ©Aβββ (?πg ββ©Aβββ Οβ¦NTMapβ¦β¦a'β¦))) =
?π'f ββ©Aβββ (Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ (h ββ©Aβββ (Οβ¦NTMapβ¦β¦aβ¦ ββ©Aβββ ?πg)))".
from prems Set.category_axioms category_axioms assms(1,2,4) g show
"(?Y_a'b' ββ©Aβcat_Set Ξ±β cf_hom β [?πg, ?π'f]β©β)β¦ArrValβ¦β¦hβ¦ =
(cf_hom β [?πg, ?π'f]β©β ββ©Aβcat_Set Ξ±β ?Y_ab)β¦ArrValβ¦β¦hβ¦"
by
(
cs_concl
cs_simp: nat cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_a'b_Ggπ'f arr_Set_πgπ'f_ab in auto)
qed (use a'b_Ggπ'f πgπ'f_ab in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
subsubsectionβΉ
Composition of the components of a composition of a βΉHomβΊ-natural
transformation with natural transformations
βΊ
lemma (in category) cat_ntcf_Hom_component_Comp:
assumes "Ο' : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β β"
and "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο' : π' β¦β©Cβ©F β' : π
β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows
"ntcf_Hom_component Ο Ο' a b ββ©Aβcat_Set Ξ±β ntcf_Hom_component Ο' Ο a b =
ntcf_Hom_component (Ο' ββ©Nβ©Tβ©Cβ©F Ο) (Ο' ββ©Nβ©Tβ©Cβ©F Ο) a b"
(is βΉ?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο = ?Ο'ΟΟ'ΟβΊ)
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
from assms Set.category_axioms category_axioms have ΟΟ'_Ο'Ο:
"?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο :
Hom β (ββ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (β'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
then have dom_lhs:
"πβ©β ((?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο)β¦ArrValβ¦) =
Hom β (ββ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
from assms Set.category_axioms category_axioms have Ο'ΟΟ'Ο:
"?Ο'ΟΟ'Ο :
Hom β (ββ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (β'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
then have dom_rhs:
"πβ©β (?Ο'ΟΟ'Οβ¦ArrValβ¦) = Hom β (ββ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from ΟΟ'_Ο'Ο show arr_Set_ΟΟ'_Ο'Ο: "arr_Set Ξ± (?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο)"
by (auto dest: cat_Set_is_arrD(1))
from Ο'ΟΟ'Ο show arr_Set_Ο'ΟΟ'Ο: "arr_Set Ξ± ?Ο'ΟΟ'Ο"
by (auto dest: cat_Set_is_arrD(1))
show "(?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο)β¦ArrValβ¦ = ?Ο'ΟΟ'Οβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : ββ¦ObjMapβ¦β¦aβ¦ β¦βββ π'β¦ObjMapβ¦β¦bβ¦"
with category_axioms assms Set.category_axioms show
"(?ΟΟ' ββ©Aβcat_Set Ξ±β ?Ο'Ο)β¦ArrValβ¦β¦fβ¦ = ?Ο'ΟΟ'Οβ¦ArrValβ¦β¦fβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_Ο'ΟΟ'Ο arr_Set_ΟΟ'_Ο'Ο in auto)
qed (use ΟΟ'_Ο'Ο Ο'ΟΟ'Ο in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp
subsubsectionβΉ
Component of a composition of βΉHomβΊ-natural
transformation with the identity natural transformations
βΊ
lemma (in category) cat_ntcf_Hom_component_ntcf_id:
assumes "π : π β¦β¦β©CβΞ±β β"
and "π': π
β¦β¦β©CβΞ±β β"
and "a ββ©β πβ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows
"ntcf_Hom_component (ntcf_id π) (ntcf_id π') a b =
cat_Set Ξ±β¦CIdβ¦β¦Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)β¦"
(is βΉ?ππ' = cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦βΊ)
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret π': is_functor Ξ± π
β π' by (rule assms(2))
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
from assms Set.category_axioms category_axioms have ππ':
"?ππ' :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
then have dom_lhs: "πβ©β (?ππ'β¦ArrValβ¦) = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
from category_axioms assms Set.category_axioms have πaπ'b:
"cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦ :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by
(
cs_concl cs_full
cs_simp: cat_Set_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros
)
then have dom_rhs:
"πβ©β (cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦β¦ArrValβ¦) = Hom β (πβ¦ObjMapβ¦β¦aβ¦) (π'β¦ObjMapβ¦β¦bβ¦)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from ππ' show arr_Set_πΟ: "arr_Set Ξ± ?ππ'"
by (auto dest: cat_Set_is_arrD(1))
from πaπ'b show arr_Set_πaπ'b: "arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦)"
by (auto dest: cat_Set_is_arrD(1))
show "?ππ'β¦ArrValβ¦ = cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ π'β¦ObjMapβ¦β¦bβ¦"
with category_axioms Set.category_axioms assms show
"?ππ'β¦ArrValβ¦β¦fβ¦ = cat_Set Ξ±β¦CIdβ¦β¦?πaπ'bβ¦β¦ArrValβ¦β¦fβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use arr_Set_πaπ'b in auto)
qed (use ππ' πaπ'b in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id
subsectionβΉ
Component of a composition of a βΉHomβΊ-natural transformation
with a natural transformation
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_lcomp_Hom_component :: "V β V β V β V"
where "ntcf_lcomp_Hom_component Ο a b =
ntcf_Hom_component Ο (ntcf_id (cf_id (Οβ¦NTDGCodβ¦))) a b"
definition ntcf_rcomp_Hom_component :: "V β V β V β V"
where "ntcf_rcomp_Hom_component Ο a b =
ntcf_Hom_component (ntcf_id (cf_id (Οβ¦NTDGCodβ¦))) Ο a b"
subsubsectionβΉArrow valueβΊ
lemma ntcf_lcomp_Hom_component_ArrVal_vsv:
"vsv (ntcf_lcomp_Hom_component Ο a bβ¦ArrValβ¦)"
unfolding ntcf_lcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
lemma ntcf_rcomp_Hom_component_ArrVal_vsv:
"vsv (ntcf_rcomp_Hom_component Ο a bβ¦ArrValβ¦)"
unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)
lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β" and "b ββ©β ββ¦Objβ¦"
shows "πβ©β (ntcf_lcomp_Hom_component Ο a bβ¦ArrValβ¦) = Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
show ?thesis
using assms
unfolding ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β" and "a ββ©β op_cat ββ¦Objβ¦"
shows "πβ©β (ntcf_rcomp_Hom_component Ο a bβ¦ArrValβ¦) = Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrVal_app[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "h : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ b"
shows "ntcf_lcomp_Hom_component Ο a bβ¦ArrValβ¦β¦hβ¦ = h ββ©Aβββ Οβ¦NTMapβ¦β¦aβ¦"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_app[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "h : a β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
shows "ntcf_rcomp_Hom_component Ο a bβ¦ArrValβ¦β¦hβ¦ = Οβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ h"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
show ?thesis
using assms
unfolding cat_op_simps ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrVal_vrange:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
shows "ββ©β (ntcf_lcomp_Hom_component Ο a bβ¦ArrValβ¦) ββ©β Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms(2) have a: "a ββ©β πβ¦Objβ¦" unfolding cat_op_simps by simp
from assms(1,3) a have
"ββ©β (ntcf_lcomp_Hom_component Ο a bβ¦ArrValβ¦) ββ©β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (cf_id ββ¦ObjMapβ¦β¦bβ¦)"
by
(
unfold cat_op_simps ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod,
intro ntcf_Hom_component_ArrVal_vrange
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
from this assms(3) show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed
lemma ntcf_rcomp_Hom_component_ArrVal_vrange:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "ββ©β (ntcf_rcomp_Hom_component Ο a bβ¦ArrValβ¦) ββ©β Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms(2) have a: "a ββ©β ββ¦Objβ¦" unfolding cat_op_simps by simp
from assms(1,3) a have
"ββ©β (ntcf_rcomp_Hom_component Ο a bβ¦ArrValβ¦) ββ©β
Hom β (cf_id ββ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦)"
by
(
unfold ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod,
intro ntcf_Hom_component_ArrVal_vrange
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from this a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed
subsubsectionβΉArrow domain and codomainβΊ
lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β" and "b ββ©β ββ¦Objβ¦"
shows "ntcf_lcomp_Hom_component Ο a bβ¦ArrDomβ¦ = Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrDom[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β" and "a ββ©β op_cat ββ¦Objβ¦"
shows "ntcf_rcomp_Hom_component Ο a bβ¦ArrDomβ¦ = Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding cat_op_simps ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_component_ArrCod[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β" and "b ββ©β ββ¦Objβ¦"
shows "ntcf_lcomp_Hom_component Ο a bβ¦ArrCodβ¦ = Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_component_ArrCod[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β" and "a ββ©β op_cat ββ¦Objβ¦"
shows "ntcf_rcomp_Hom_component Ο a bβ¦ArrCodβ¦ = Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding cat_op_simps ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
subsubsectionβΉ
Component of a composition of a βΉHomβΊ-natural transformation
with a natural transformation is an arrow in the category βΉSetβΊ
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
shows "ntcf_lcomp_Hom_component Ο a b :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) b β¦βcat_Set Ξ±β Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms have a: "a ββ©β πβ¦Objβ¦" unfolding cat_op_simps by simp
from assms(1,3) a have
"ntcf_lcomp_Hom_component Ο a b :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (cf_id ββ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (πβ¦ObjMapβ¦β¦aβ¦) (cf_id ββ¦ObjMapβ¦β¦bβ¦)"
unfolding ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (intro cat_ntcf_Hom_component_is_arr)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)+
from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed
lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr':
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "π' = Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
and "π
' = Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
and "β' = cat_Set Ξ±"
shows "ntcf_lcomp_Hom_component Ο a b : π' β¦ββ'β π
'"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_ntcf_lcomp_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_component_is_arr'
lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "ntcf_rcomp_Hom_component Ο a b :
Hom β a (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms have a: "a ββ©β ββ¦Objβ¦" unfolding cat_op_simps by simp
from assms(1,3) a have
"ntcf_rcomp_Hom_component Ο a b :
Hom β (cf_id ββ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦) β¦βcat_Set Ξ±β
Hom β (cf_id ββ¦ObjMapβ¦β¦aβ¦) (πβ¦ObjMapβ¦β¦bβ¦)"
unfolding ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (intro cat_ntcf_Hom_component_is_arr)
(cs_concl cs_intro: cat_cs_intros cat_op_intros)
from this assms(1,3) a show ?thesis by (cs_prems cs_simp: cat_cs_simps)
qed
lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr':
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
and "π' = Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
and "π
' = Hom β a (πβ¦ObjMapβ¦β¦bβ¦)"
and "β' = cat_Set Ξ±"
shows "ntcf_rcomp_Hom_component Ο a b : π' β¦ββ'β π
'"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_ntcf_rcomp_Hom_component_is_arr)
lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_component_is_arr'
subsectionβΉ
Composition of a βΉHomβΊ-natural transformation with two natural transformations
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee subsection 1.15 in \cite{bodo_categories_1970}.βΊ
definition ntcf_Hom :: "V β V β V β V" (βΉHomβ©Aβ©.β©CΔ±'(/_-,_-/')βΊ)
where "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-) =
[
(
Ξ»abββ©β(op_cat (Οβ¦NTDGDomβ¦) Γβ©C Οβ¦NTDGDomβ¦)β¦Objβ¦.
ntcf_Hom_component Ο Ο (vpfst ab) (vpsnd ab)
),
Homβ©Oβ©.β©CβΞ±βΟβ¦NTDGCodβ¦(Οβ¦NTCodβ¦-,Οβ¦NTDomβ¦-),
Homβ©Oβ©.β©CβΞ±βΟβ¦NTDGCodβ¦(Οβ¦NTDomβ¦-,Οβ¦NTCodβ¦-),
op_cat (Οβ¦NTDGDomβ¦) Γβ©C Οβ¦NTDGDomβ¦,
cat_Set Ξ±
]β©β"
textβΉComponents.βΊ
lemma ntcf_Hom_components:
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦ =
(
Ξ»abββ©β(op_cat (Οβ¦NTDGDomβ¦) Γβ©C Οβ¦NTDGDomβ¦)β¦Objβ¦.
ntcf_Hom_component Ο Ο (vpfst ab) (vpsnd ab)
)"
and "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTDomβ¦ =
Homβ©Oβ©.β©CβΞ±βΟβ¦NTDGCodβ¦(Οβ¦NTCodβ¦-,Οβ¦NTDomβ¦-)"
and "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTCodβ¦ =
Homβ©Oβ©.β©CβΞ±βΟβ¦NTDGCodβ¦(Οβ¦NTDomβ¦-,Οβ¦NTCodβ¦-)"
and "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTDGDomβ¦ = op_cat (Οβ¦NTDGDomβ¦) Γβ©C Οβ¦NTDGDomβ¦"
and "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_Hom_components(1)
|vsv ntcf_Hom_NTMap_vsv|
context
fixes Ξ± Ο Ο π π π' π' π π
β
assumes Ο: "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and Ο: "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
begin
interpretation Ο: is_ntcf Ξ± π β π π Ο by (rule Ο)
interpretation Ο: is_ntcf Ξ± π
β π' π' Ο by (rule Ο)
mk_VLambda ntcf_Hom_components(1)[of _ Ο Ο, simplified]
|vdomain ntcf_Hom_NTMap_vdomain[unfolded in_Hom_iff]|
lemmas [cat_cs_simps] = ntcf_Hom_NTMap_vdomain
lemma ntcf_Hom_NTMap_app[cat_cs_simps]:
assumes "[a, b]β©β ββ©β (op_cat π Γβ©C π
)β¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦a, bβ¦β©β = ntcf_Hom_component Ο Ο a b"
using assms
unfolding ntcf_Hom_components
by (simp add: nat_omega_simps cat_cs_simps)
end
lemma (in category) ntcf_Hom_NTMap_vrange:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β" and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
interpret Ο: is_ntcf Ξ± π
β π' π' Ο by (rule assms(2))
show ?thesis
proof
(
rule vsv.vsv_vrange_vsubset,
unfold ntcf_Hom_NTMap_vdomain[OF assms] cat_cs_simps
)
fix ab assume "ab ββ©β (op_cat π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β op_cat πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by
(
rule cat_prod_2_ObjE[
OF Ο.NTDom.HomDom.category_op Ο.NTDom.HomDom.category_axioms
]
)
from assms a b category_cat_Set category_axioms show
"Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦abβ¦ ββ©β cat_Set Ξ±β¦Arrβ¦"
unfolding ab_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (simp add: ntcf_Hom_NTMap_vsv)
qed
subsubsectionβΉ
Composition of a βΉHomβΊ-natural transformation with
two natural transformations is a natural transformation
βΊ
lemma (in category) cat_ntcf_Hom_is_ntcf:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β" and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) :
op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
interpret Ο: is_ntcf Ξ± π
β π' π' Ο by (rule assms(2))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-))" unfolding ntcf_Hom_def by simp
show "vcard (Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)) = 5β©β"
unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
from assms category_axioms show
"Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) : op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from assms category_axioms show
"Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) : op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "πβ©β (Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦) = (op_cat π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦abβ¦ :
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ObjMapβ¦β¦abβ¦ β¦βcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ObjMapβ¦β¦abβ¦"
if "ab ββ©β (op_cat π Γβ©C π
)β¦Objβ¦" for ab
proof-
from that obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β op_cat πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by
(
rule cat_prod_2_ObjE[
OF Ο.NTDom.HomDom.category_op Ο.NTDom.HomDom.category_axioms
]
)
from category_axioms assms a b show
"Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦abβ¦ :
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ObjMapβ¦β¦abβ¦ β¦βcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ObjMapβ¦β¦abβ¦"
unfolding ab_def cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦a'b'β¦ ββ©Aβcat_Set Ξ±β
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ArrMapβ¦β¦gfβ¦ =
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦ArrMapβ¦β¦gfβ¦ ββ©Aβcat_Set Ξ±β
Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-)β¦NTMapβ¦β¦abβ¦"
if "gf : ab β¦βop_cat π Γβ©C π
β a'b'" for ab a'b' gf
proof-
from that obtain g f a b a' b'
where gf_def: "gf = [g, f]β©β"
and ab_def: "ab = [a, b]β©β"
and a'b'_def: "a'b' = [a', b']β©β"
and g: "g : a β¦βop_cat πβ a'"
and f: "f : b β¦βπ
β b'"
by
(
elim
cat_prod_2_is_arrE[
OF Ο.NTDom.HomDom.category_op Ο.NTDom.HomDom.category_axioms
]
)
from assms category_axioms that g f show ?thesis
unfolding gf_def ab_def a'b'_def cat_op_simps
by
(
cs_concl
cs_simp: cat_ntcf_Hom_component_nat cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: ntcf_Hom_components cat_cs_simps)
qed
lemma (in category) cat_ntcf_Hom_is_ntcf':
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)"
and "π
' = Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)"
and "β' = op_cat π Γβ©C π
"
and "π' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,Ο-) : π' β¦β©Cβ©F π
' : β' β¦β¦β©CβΞ²β π'"
using assms(1-2) unfolding assms(3-7) by (rule cat_ntcf_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_is_ntcf'
subsubsectionβΉ
Composition of a βΉHomβΊ-natural transformation with
two vertical compositions of natural transformations
βΊ
lemma (in category) cat_ntcf_Hom_vcomp:
assumes "Ο' : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β β"
and "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ο' : π' β¦β©Cβ©F β' : π
β¦β¦β©CβΞ±β β"
and "Ο : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ±β β"
shows
"Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-) =
Homβ©Aβ©.β©CβΞ±β(Ο-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,Ο-)"
proof(rule ntcf_eqI[of Ξ±])
interpret Ο': is_ntcf Ξ± π β π β Ο' by (rule assms(1))
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(2))
interpret Ο': is_ntcf Ξ± π
β π' β' Ο' by (rule assms(3))
interpret Ο: is_ntcf Ξ± π
β π' π' Ο by (rule assms(4))
from category_axioms assms show H_vcomp:
"Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-) :
Homβ©Oβ©.β©CβΞ±ββ(β-,π'-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,β'-) :
op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show vcomp_H:
"Homβ©Aβ©.β©CβΞ±β(Ο-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,Ο-) :
Homβ©Oβ©.β©CβΞ±ββ(β-,π'-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,β'-) :
op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_vcomp have dom_H_vcomp:
"πβ©β (Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-)β¦NTMapβ¦) = (op_cat π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_vcomp have dom_vcomp_H:
"πβ©β ((Homβ©Aβ©.β©CβΞ±β(Ο-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,Ο-))β¦NTMapβ¦) =
(op_cat π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-)β¦NTMapβ¦ =
(Homβ©Aβ©.β©CβΞ±β(Ο-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,Ο-))β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
fix ab assume prems: "ab ββ©β (op_cat π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by
(
auto
elim:
cat_prod_2_ObjE[
OF Ο'.NTDom.HomDom.category_op Ο'.NTDom.HomDom.category_axioms
]
simp: cat_op_simps
)
from
assms a b
category_axioms
Ο'.NTDom.HomDom.category_axioms
Ο'.NTDom.HomDom.category_axioms
show
"Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-)β¦NTMapβ¦β¦abβ¦ =
(Homβ©Aβ©.β©CβΞ±β(Ο-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,Ο-))β¦NTMapβ¦β¦abβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps ab_def
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (auto simp: ntcf_Hom_NTMap_vsv cat_cs_intros)
qed simp_all
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_vcomp
lemma (in category) cat_ntcf_Hom_ntcf_id:
assumes "π : π β¦β¦β©CβΞ±β β" and "π': π
β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)"
proof(rule ntcf_eqI[of Ξ±])
interpret π: is_functor Ξ± π β π by (rule assms(1))
interpret π': is_functor Ξ± π
β π' by (rule assms(2))
from category_axioms assms show H_id:
"Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) :
op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show id_H:
"ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,π'-) :
op_cat π Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_id have dom_H_id:
"πβ©β (Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-)β¦NTMapβ¦) = (op_cat π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms H_id have dom_id_H:
"πβ©β (ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦NTMapβ¦) = (op_cat π Γβ©C π
)β¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-)β¦NTMapβ¦ =
ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
show "vsv (Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-)β¦NTMapβ¦)"
by (rule ntcf_Hom_NTMap_vsv)
from id_H show "vsv (ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦NTMapβ¦)"
by (intro is_functor.ntcf_id_NTMap_vsv)
(cs_concl cs_simp: cs_intro: cat_cs_intros)
fix ab assume "ab ββ©β (op_cat π Γβ©C π
)β¦Objβ¦"
then obtain a b
where ab_def: "ab = [a, b]β©β"
and a: "a ββ©β πβ¦Objβ¦"
and b: "b ββ©β π
β¦Objβ¦"
by
(
auto
elim:
cat_prod_2_ObjE[OF π.HomDom.category_op π'.HomDom.category_axioms]
simp: cat_op_simps
)
from category_axioms assms a b H_id id_H show
"Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,ntcf_id π'-)β¦NTMapβ¦β¦abβ¦ =
ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,π'-)β¦NTMapβ¦β¦abβ¦"
unfolding ab_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed simp
qed simp_all
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_ntcf_id
subsectionβΉ
Composition of a βΉHomβΊ-natural transformation with a natural transformation
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee subsection 1.15 in \cite{bodo_categories_1970}.βΊ
definition ntcf_lcomp_Hom :: "V β V β V" (βΉHomβ©Aβ©.β©CΔ±'(/_-,-/')βΊ)
where "Homβ©Aβ©.β©CβΞ±β(Ο-,-) = Homβ©Aβ©.β©CβΞ±β(Ο-,ntcf_id (cf_id (Οβ¦NTDGCodβ¦))-)"
definition ntcf_rcomp_Hom :: "V β V β V" (βΉHomβ©Aβ©.β©CΔ±'(/-,_-/')βΊ)
where "Homβ©Aβ©.β©CβΞ±β(-,Ο-) = Homβ©Aβ©.β©CβΞ±β(ntcf_id (cf_id (Οβ¦NTDGCodβ¦))-,Ο-)"
subsubsectionβΉNatural transformation mapβΊ
lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (Homβ©Aβ©.β©CβΞ±β(Ο-,-)β¦NTMapβ¦)"
unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (Homβ©Aβ©.β©CβΞ±β(-,Ο-)β¦NTMapβ¦)"
unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)
lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Aβ©.β©CβΞ±β(Ο-,-)β¦NTMapβ¦) = (op_cat π Γβ©C β)β¦Objβ¦"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_rcomp_Hom_NTMap_vdomain[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β (Homβ©Aβ©.β©CβΞ±β(-,Ο-)β¦NTMapβ¦) = (op_cat β Γβ©C π
)β¦Objβ¦"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_rcomp_Hom_def Ο.ntcf_NTDGCod
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma ntcf_lcomp_Hom_NTMap_app[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat πβ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-)β¦NTMapβ¦β¦a, bβ¦β©β = ntcf_lcomp_Hom_component Ο a b"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
show ?thesis
unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
using assms unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma ntcf_rcomp_Hom_NTMap_app[cat_cs_simps]:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "a ββ©β op_cat ββ¦Objβ¦"
and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±β(-,Ο-)β¦NTMapβ¦β¦a, bβ¦β©β = ntcf_rcomp_Hom_component Ο a b"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
show ?thesis
unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
using assms unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
lemma (in category) ntcf_lcomp_Hom_NTMap_vrange:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Aβ©.β©CβΞ±β(Ο-,-)β¦NTMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def Ο.ntcf_NTDGCod
by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) ntcf_rcomp_Hom_NTMap_vrange:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β (Homβ©Aβ©.β©CβΞ±β(-,Ο-)β¦NTMapβ¦) ββ©β cat_Set Ξ±β¦Arrβ¦"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms show ?thesis
unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def Ο.ntcf_NTDGCod
by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed
subsubsectionβΉ
Composition of a βΉHomβΊ-natural transformation with
a natural transformation is a natural transformation
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf:
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,-) : op_cat π Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(1))
from assms category_axioms show ?thesis
unfolding
ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] Ο.ntcf_NTDGCod
by (intro category.cat_ntcf_Hom_is_ntcf)
(cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf':
assumes "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
and "π
' = Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
and "β' = op_cat π Γβ©C β"
and "π' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-) : π' β¦β©Cβ©F π
' : β' β¦β¦β©CβΞ²β π'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_lcomp_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_is_ntcf'
lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(-,Ο-) :
Homβ©Oβ©.β©CβΞ±ββ(-,π-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,π-) : op_cat β Γβ©C π
β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms category_axioms show ?thesis
unfolding
ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] Ο.ntcf_NTDGCod
by (intro category.cat_ntcf_Hom_is_ntcf)
(cs_concl cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf':
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
and "π
' = Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
and "β' = op_cat β Γβ©C π
"
and "π' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±β(-,Ο-) : π' β¦β©Cβ©F π
' : β' β¦β¦β©CβΞ±β π'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_rcomp_Hom_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_is_ntcf'
subsubsectionβΉ
Component of a composition of a βΉHomβΊ-natural transformation
with a natural transformation and the Yoneda component
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "b ββ©β op_cat π
β¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows
"ntcf_lcomp_Hom_component Ο b c =
Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) (πβ¦ObjMapβ¦β¦bβ¦) (Οβ¦NTMapβ¦β¦bβ¦) c"
(is βΉ?lcomp = ?YcβΊ)
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms(2) have b: "b ββ©β π
β¦Objβ¦" unfolding cat_op_simps by clarsimp
from b have πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦" and πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
by (auto intro: cat_cs_intros)
from assms(1,3) b category_axioms have Οb:
"Οβ¦NTMapβ¦β¦bβ¦ ββ©β Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β¦ObjMapβ¦β¦πβ¦ObjMapβ¦β¦bβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
have lcomp:
"?lcomp : Hom β (πβ¦ObjMapβ¦β¦bβ¦) c β¦βcat_Set Ξ±β Hom β (πβ¦ObjMapβ¦β¦bβ¦) c"
by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
then have dom_lhs: "πβ©β (?lcompβ¦ArrValβ¦) = Hom β (πβ¦ObjMapβ¦β¦bβ¦) c"
by (cs_concl cs_simp: cat_cs_simps)
have Yc: "?Yc :
Hom β (πβ¦ObjMapβ¦β¦bβ¦) c β¦βcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-)β¦ObjMapβ¦β¦cβ¦"
by
(
rule cat_Yoneda_component_is_arr[
OF cat_cf_Hom_snd_is_functor[OF πb] πb Οb assms(3)
]
)
then have dom_rhs: "πβ©β (?Ycβ¦ArrValβ¦) = Hom β (πβ¦ObjMapβ¦β¦bβ¦) c"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from lcomp show "arr_Set Ξ± ?lcomp" by (auto dest: cat_Set_is_arrD(1))
from Yc show "arr_Set Ξ± ?Yc" by (auto dest: cat_Set_is_arrD(1))
show "?lcompβ¦ArrValβ¦ = ?Ycβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
from assms(1) b category_axioms show "vsv (?Ycβ¦ArrValβ¦)"
by (intro is_functor.Yoneda_component_ArrVal_vsv)
(cs_concl cs_intro: cat_cs_intros)
show "?lcompβ¦ArrValβ¦β¦fβ¦ = ?Ycβ¦ArrValβ¦β¦fβ¦"
if "f ββ©β Hom β (πβ¦ObjMapβ¦β¦bβ¦) c" for f
proof-
from that have "f : πβ¦ObjMapβ¦β¦bβ¦ β¦βββ c" by simp
with category_axioms assms(1,3) b show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed (simp_all add: ntcf_lcomp_Hom_component_ArrVal_vsv)
from Yc category_axioms assms(1,3) b have
"?Yc : Hom β (πβ¦ObjMapβ¦β¦bβ¦) c β¦βcat_Set Ξ±β Hom β (πβ¦ObjMapβ¦β¦bβ¦) c"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
with lcomp show "?lcompβ¦ArrCodβ¦ = ?Ycβ¦ArrCodβ¦"
by (cs_concl cs_simp: cat_cs_simps)
qed (use lcomp Yc in βΉcs_concl cs_simp: cat_cs_simpsβΊ)
qed
subsubsectionβΉ
Composition of a βΉHomβΊ-natural transformation with
a vertical composition of natural transformations
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
assumes "Ο' : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β β" and "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(Ο' ββ©Nβ©Tβ©Cβ©F Ο-,-) = Homβ©Aβ©.β©CβΞ±β(Ο-,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(Ο'-,-)"
proof-
interpret Ο': is_ntcf Ξ± π β π β Ο' by (rule assms(1))
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(2))
from category_axioms have ntcf_id_cf_id:
"ntcf_id (cf_id β) = ntcf_id (cf_id β) ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id β)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show ?thesis
unfolding
ntcf_lcomp_Hom_def
ntsmcf_vcomp_components
dghm_id_components
Ο'.ntcf_NTDGCod
Ο.ntcf_NTDGCod
by (subst ntcf_id_cf_id)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_vcomp
lemma (in category) cat_ntcf_rcomp_Hom_vcomp:
assumes "Ο' : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β β" and "Ο : π β¦β©Cβ©F π : π β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(-,Ο' ββ©Nβ©Tβ©Cβ©F Ο-) = Homβ©Aβ©.β©CβΞ±β(-,Ο'-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±β(-,Ο-)"
proof-
interpret Ο': is_ntcf Ξ± π β π β Ο' by (rule assms(1))
interpret Ο: is_ntcf Ξ± π β π π Ο by (rule assms(2))
from category_axioms have ntcf_id_cf_id:
"ntcf_id (cf_id β) = ntcf_id (cf_id β) ββ©Nβ©Tβ©Cβ©F ntcf_id (cf_id β)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show ?thesis
unfolding
ntcf_rcomp_Hom_def
ntsmcf_vcomp_components
dghm_id_components
Ο'.ntcf_NTDGCod
Ο.ntcf_NTDGCod
by (subst ntcf_id_cf_id)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_vcomp
subsubsectionβΉ
Composition of a βΉHomβΊ-natural transformation with an identity natural
transformation
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
assumes "π : π β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(ntcf_id π-,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
proof-
interpret π: is_functor Ξ± π β π by (rule assms(1))
from category_axioms assms show ?thesis
unfolding ntcf_lcomp_Hom_def ntcf_id_components π.cf_HomCod
by
(
cs_concl
cs_simp: ntcf_lcomp_Hom_def cat_cs_simps
cs_intro: cat_cs_intros
)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_id
lemma (in category) cat_ntcf_rcomp_Hom_ntcf_id:
assumes "π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(-,ntcf_id π-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(-,π-)"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
from category_axioms assms show ?thesis
unfolding ntcf_rcomp_Hom_def ntcf_id_components π.cf_HomCod
by (cs_concl cs_simp: ntcf_rcomp_Hom_def cat_cs_simps cs_intro: cat_cs_intros)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_ntcf_id
subsectionβΉProjections of a βΉHomβΊ-natural transformationβΊ
textβΉ
The concept of a projection of a βΉHomβΊ-natural transformation appears
in the corollary to the Yoneda Lemma in Chapter III-2 in
\cite{mac_lane_categories_2010} (although the concept has not been given
any specific name in the aforementioned reference).
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition ntcf_Hom_snd :: "V β V β V β V" (βΉHomβ©Aβ©.β©CΔ±_'(/_,-/')βΊ)
where "Homβ©Aβ©.β©CβΞ±ββ(f,-) =
Yoneda_arrow Ξ± (Homβ©Oβ©.β©CβΞ±ββ(ββ¦Domβ¦β¦fβ¦,-)) (ββ¦Codβ¦β¦fβ¦) f"
definition ntcf_Hom_fst :: "V β V β V β V" (βΉHomβ©Aβ©.β©CΔ±_'(/-,_/')βΊ)
where "Homβ©Aβ©.β©CβΞ±ββ(-,f) = Homβ©Aβ©.β©CβΞ±βop_cat β(f,-)"
textβΉComponents.βΊ
lemma (in category) cat_ntcf_Hom_snd_components:
assumes "f : s β¦βββ r"
shows "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTMapβ¦ =
(Ξ»dββ©βββ¦Objβ¦. Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(s,-) r f d)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±ββ(r,-)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±ββ(s,-)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDGDomβ¦ = β"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDGCodβ¦ = cat_Set Ξ±"
proof-
interpret is_functor Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(s,-)βΊ
using assms category_axioms by (cs_concl cs_simp: cs_intro: cat_cs_intros)
show "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTMapβ¦ =
(Ξ»dββ©βββ¦Objβ¦. Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(s,-) r f d)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±ββ(r,-)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±ββ(s,-)"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDGDomβ¦ = β"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦NTDGCodβ¦ = cat_Set Ξ±"
unfolding ntcf_Hom_snd_def cat_is_arrD[OF assms] Yoneda_arrow_components
by simp_all
qed
lemma (in category) cat_ntcf_Hom_fst_components:
assumes "f : r β¦βββ s"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦NTMapβ¦ =
(Ξ»dββ©βop_cat ββ¦Objβ¦. Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(-,s) r f d)"
and "Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦NTDomβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,r)"
and "Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦NTCodβ¦ = Homβ©Oβ©.β©CβΞ±ββ(-,s)"
and "Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦NTDGDomβ¦ = op_cat β"
and "Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦NTDGCodβ¦ = cat_Set Ξ±"
using category_axioms assms
unfolding
ntcf_Hom_fst_def
category.cat_ntcf_Hom_snd_components[
OF category_op, unfolded cat_op_simps, OF assms
]
cat_op_simps
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+
textβΉAlternative definition.βΊ
lemma (in category) ntcf_Hom_snd_def':
assumes "f : r β¦βββ s"
shows "Homβ©Aβ©.β©CβΞ±ββ(f,-) = Yoneda_arrow Ξ± (Homβ©Oβ©.β©CβΞ±ββ(r,-)) s f"
using assms unfolding ntcf_Hom_snd_def by (simp add: cat_cs_simps)
lemma (in category) ntcf_Hom_fst_def':
assumes "f : r β¦βββ s"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,f) = Yoneda_arrow Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) r f"
proof-
from assms category_axioms show ?thesis
unfolding ntcf_Hom_fst_def ntcf_Hom_snd_def cat_op_simps
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed
subsubsectionβΉNatural transformation mapβΊ
context category
begin
context
fixes s r f
assumes f: "f : s β¦βββ r"
begin
mk_VLambda cat_ntcf_Hom_snd_components(1)[OF f]
|vsv ntcf_Hom_snd_NTMap_vsv[intro]|
|vdomain ntcf_Hom_snd_NTMap_vdomain|
|app ntcf_Hom_snd_NTMap_app|
end
context
fixes s r f
assumes f: "f : r β¦βββ s"
begin
mk_VLambda cat_ntcf_Hom_fst_components(1)[OF f]
|vsv ntcf_Hom_fst_NTMap_vsv[intro]|
|vdomain ntcf_Hom_fst_NTMap_vdomain|
|app ntcf_Hom_fst_NTMap_app|
end
end
lemmas [cat_cs_simps] =
category.ntcf_Hom_snd_NTMap_vdomain
category.ntcf_Hom_fst_NTMap_vdomain
lemmas ntcf_Hom_snd_NTMap_app[cat_cs_simps] =
category.ntcf_Hom_snd_NTMap_app
category.ntcf_Hom_fst_NTMap_app
subsubsectionβΉ
βΉHomβΊ-natural transformation projections are natural transformations
βΊ
lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
assumes "f : s β¦βββ r"
shows "Homβ©Aβ©.β©CβΞ±ββ(f,-) :
Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
note f = cat_is_arrD[OF assms]
show ?thesis
unfolding ntcf_Hom_snd_def f
proof(rule category.cat_Yoneda_arrow_is_ntcf)
from assms category_axioms show "f ββ©β Homβ©Oβ©.β©CβΞ±ββ(s,-)β¦ObjMapβ¦β¦rβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed (intro category_axioms cat_cf_Hom_snd_is_functor f)+
qed
lemma (in category) cat_ntcf_Hom_snd_is_ntcf':
assumes "f : s β¦βββ r"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(r,-)"
and "π
' = Homβ©Oβ©.β©CβΞ±ββ(s,-)"
and "β' = β"
and "π' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±ββ(f,-) : π' β¦β©Cβ©F π
' : β' β¦β¦β©CβΞ²β π'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_snd_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_snd_is_ntcf'
lemma (in category) cat_ntcf_Hom_fst_is_ntcf:
assumes "f : r β¦βββ s"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,f) :
Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from assms have r: "r ββ©β ββ¦Objβ¦" and s: "s ββ©β ββ¦Objβ¦" by auto
from
category.cat_ntcf_Hom_snd_is_ntcf[
OF category_op,
unfolded cat_op_simps,
OF assms,
unfolded cat_op_cat_cf_Hom_snd[OF r] cat_op_cat_cf_Hom_snd[OF s],
folded ntcf_Hom_fst_def
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_fst_is_ntcf':
assumes "f : r β¦βββ s"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(-,r)"
and "π
' = Homβ©Oβ©.β©CβΞ±ββ(-,s)"
and "β' = op_cat β"
and "π' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,f) : π' β¦β©Cβ©F π
' : β' β¦β¦β©CβΞ²β π'"
using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_fst_is_ntcf)
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_fst_is_ntcf'
subsubsectionβΉOpposite βΉHomβΊ-natural transformation projectionsβΊ
lemma (in category) cat_op_cat_ntcf_Hom_snd:
"Homβ©Aβ©.β©CβΞ±βop_cat β(f,-) = Homβ©Aβ©.β©CβΞ±ββ(-,f)"
unfolding ntcf_Hom_fst_def by simp
lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_snd
lemma (in category) cat_op_cat_ntcf_Hom_fst:
"Homβ©Aβ©.β©CβΞ±βop_cat β(-,f) = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
unfolding ntcf_Hom_fst_def cat_op_simps by simp
lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst
subsubsectionβΉ
βΉHomβΊ-natural transformation projections and the Yoneda component
βΊ
lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
assumes "g : b β¦βββ c" and "f : a β¦βββ b" and "d ββ©β ββ¦Objβ¦"
shows
"Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(a,-) b f d ββ©Aβcat_Set Ξ±β
Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(b,-) c g d =
Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(a,-) c (g ββ©Aβββ f) d"
(is βΉ?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d = ?Ya c (g ββ©Aβββ f) dβΊ)
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
note gD = cat_is_arrD[OF assms(1)]
note fD = cat_is_arrD[OF assms(2)]
from assms category_axioms have Y_f:
"?Ya b f d : Hom β b d β¦βcat_Set Ξ±β Hom β a d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
moreover from assms category_axioms have Y_g:
"?Yb c g d : Hom β c d β¦βcat_Set Ξ±β Hom β b d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
ultimately have Yf_Yg:
"?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d : Hom β c d β¦βcat_Set Ξ±β Hom β a d"
by (auto intro: cat_cs_intros)
from assms category_axioms have Y_gf:
"?Ya c (g ββ©Aβββ f) d : Hom β c d β¦βcat_Set Ξ±β Hom β a d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from Yf_Yg have dom_rhs:
"πβ©β ((?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d)β¦ArrValβ¦) = Hom β c d"
by (cs_concl cs_simp: cat_cs_simps)
from Y_gf have dom_lhs: "πβ©β (?Ya c (g ββ©Aβββ f) dβ¦ArrValβ¦) = Hom β c d"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from Yf_Yg show arr_Set_Yf_Yg:
"arr_Set Ξ± (?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d)"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set Ξ± βΉ?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g dβΊ
by (rule arr_Set_Yf_Yg)
from Y_gf show arr_Set_Y_gf: "arr_Set Ξ± (?Ya c (g ββ©Aβββ f) d)"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set Ξ± βΉ?Ya c (g ββ©Aβββ f) dβΊ by (rule arr_Set_Y_gf)
show
"(?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d)β¦ArrValβ¦ =
?Ya c (g ββ©Aβββ f) dβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume "h : c β¦βββ d"
with Y_gf Y_g Y_f category_axioms assms show
"(?Ya b f d ββ©Aβcat_Set Ξ±β ?Yb c g d)β¦ArrValβ¦β¦hβ¦ =
?Ya c (g ββ©Aβββ f) dβ¦ArrValβ¦β¦hβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed auto
qed (use Y_gf Yf_Yg in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] =
category.cat_Yoneda_component_cf_Hom_snd_Comp[symmetric]
lemma (in category) cat_Yoneda_component_cf_Hom_snd_CId:
assumes "c ββ©β ββ¦Objβ¦" and "d ββ©β ββ¦Objβ¦"
shows
"Yoneda_component Homβ©Oβ©.β©CβΞ±ββ(c,-) c (ββ¦CIdβ¦β¦cβ¦) d =
cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦"
(is βΉ?Ycd = cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦βΊ)
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
from assms category_axioms have Y_CId_c:
"?Ycd : Hom β c d β¦βcat_Set Ξ±β Hom β c d"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from Y_CId_c Set.category_axioms assms category_axioms have CId_cd:
"cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦ : Hom β c d β¦βcat_Set Ξ±β Hom β c d"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from Y_CId_c have dom_lhs: "πβ©β (?Ycdβ¦ArrValβ¦) = Hom β c d"
by (cs_concl cs_simp: cat_cs_simps)
from CId_cd have dom_rhs: "πβ©β (cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦β¦ArrValβ¦) = Hom β c d"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from Y_CId_c show arr_Set_Y_CId_c: "arr_Set Ξ± ?Ycd"
by (auto dest: cat_Set_is_arrD(1))
interpret Yf_Yg: arr_Set Ξ± ?Ycd by (rule arr_Set_Y_CId_c)
from CId_cd show arr_Set_CId_cd: "arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦)"
by (auto dest: cat_Set_is_arrD(1))
interpret CId_cd: arr_Set Ξ± βΉcat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦βΊ
by (rule arr_Set_CId_cd)
show "?Ycdβ¦ArrValβ¦ = cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume "h : c β¦βββ d"
with CId_cd Y_CId_c category_axioms assms show
"?Ycdβ¦ArrValβ¦β¦hβ¦ = cat_Set Ξ±β¦CIdβ¦β¦Hom β c dβ¦β¦ArrValβ¦β¦hβ¦"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed auto
qed (use Y_CId_c CId_cd in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId
subsubsectionβΉβΉHomβΊ-natural transformation projection of a compositionβΊ
lemma (in category) cat_ntcf_Hom_snd_Comp:
assumes "g : b β¦βββ c" and "f : a β¦βββ b"
shows "Homβ©Aβ©.β©CβΞ±ββ(g ββ©Aβββ f,-) = Homβ©Aβ©.β©CβΞ±ββ(f,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(g,-)"
(is βΉ?H_gf = ?H_f ββ©Nβ©Tβ©Cβ©F ?H_gβΊ)
proof(rule ntcf_eqI[of Ξ±])
from assms category_axioms show
"?H_gf : Homβ©Oβ©.β©CβΞ±ββ(c,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show "?H_f ββ©Nβ©Tβ©Cβ©F ?H_g :
Homβ©Oβ©.β©CβΞ±ββ(c,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have lhs_dom: "πβ©β (?H_gfβ¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have rhs_dom:
"πβ©β ((?H_f ββ©Nβ©Tβ©Cβ©F ?H_g)β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?H_gfβ¦NTMapβ¦ = (?H_f ββ©Nβ©Tβ©Cβ©F ?H_g)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
fix d assume "d ββ©β ββ¦Objβ¦"
with assms category_axioms show
"?H_gfβ¦NTMapβ¦β¦dβ¦ = (?H_f ββ©Nβ©Tβ©Cβ©F ?H_g)β¦NTMapβ¦β¦dβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use assms in βΉauto intro: cat_cs_introsβΊ)
qed auto
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp
lemma (in category) cat_ntcf_Hom_fst_Comp:
assumes "g : b β¦βββ c" and "f : a β¦βββ b"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,g ββ©Aβββ f) = Homβ©Aβ©.β©CβΞ±ββ(-,g) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(-,f)"
proof-
note category.cat_ntcf_Hom_snd_Comp[
OF category_op, unfolded cat_op_simps, OF assms(2,1)
]
from this category_axioms assms show ?thesis
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_Comp
subsubsectionβΉβΉHomβΊ-natural transformation projection of an identityβΊ
lemma (in category) cat_ntcf_Hom_snd_CId:
assumes "c ββ©β ββ¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±ββ(ββ¦CIdβ¦β¦cβ¦,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(c,-)"
(is βΉ?H_c = ?id_H_cβΊ)
proof(rule ntcf_eqI[of Ξ±])
from assms have "ββ¦CIdβ¦β¦cβ¦ : c β¦βββ c" by (auto simp: cat_cs_intros)
from assms category_axioms show
"?H_c : Homβ©Oβ©.β©CβΞ±ββ(c,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(c,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms show
"?id_H_c : Homβ©Oβ©.β©CβΞ±ββ(c,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(c,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have lhs_dom: "πβ©β (?H_cβ¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms category_axioms have rhs_dom: "πβ©β (?id_H_cβ¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?H_cβ¦NTMapβ¦ = ?id_H_cβ¦NTMapβ¦"
proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
from assms category_axioms show "vsv (?id_H_cβ¦NTMapβ¦)"
by (intro is_functor.ntcf_id_NTMap_vsv)
(cs_concl cs_simp: cs_intro: cat_cs_intros)
fix d assume "d ββ©β ββ¦Objβ¦"
with assms category_axioms show "?H_cβ¦NTMapβ¦β¦dβ¦ = ?id_H_cβ¦NTMapβ¦β¦dβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
qed (use assms in βΉauto intro: cat_cs_introsβΊ)
qed auto
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId
lemma (in category) cat_ntcf_Hom_fst_CId:
assumes "c ββ©β ββ¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,ββ¦CIdβ¦β¦cβ¦) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(-,c)"
proof-
note category.cat_ntcf_Hom_snd_CId[
OF category_op, unfolded cat_op_simps, OF assms
]
from this category_axioms assms show ?thesis
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_CId
subsubsectionβΉβΉHomβΊ-natural transformation and the Yoneda mapβΊ
lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
assumes "f : s β¦βββ r"
shows "Yoneda_map Ξ± (Homβ©Oβ©.β©CβΞ±ββ(s,-)) rβ¦Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦ = f"
using category_axioms assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_snd
lemma (in category) cat_Yoneda_map_of_ntcf_Hom_fst:
assumes "f : r β¦βββ s"
shows "Yoneda_map Ξ± (Homβ©Oβ©.β©CβΞ±ββ(-,s)) rβ¦Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦ = f"
proof-
note category.cat_Yoneda_map_of_ntcf_Hom_snd[
OF category_op, unfolded cat_op_simps, OF assms
]
from this category_axioms assms show ?thesis
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed
lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_fst
subsectionβΉEvaluation arrowβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The evaluation arrow is a part of the definition of the evaluation functor.
The evaluation functor appears in Chapter III-2 in
\cite{mac_lane_categories_2010}.
βΊ
definition cf_eval_arrow :: "V β V β V β V"
where "cf_eval_arrow β π f =
[
(
Ξ»xββ©βπβ¦NTDomβ¦β¦ObjMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦.
πβ¦NTCodβ¦β¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦β¦ArrValβ¦β¦xβ¦β¦
),
πβ¦NTDomβ¦β¦ObjMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦,
πβ¦NTCodβ¦β¦ObjMapβ¦β¦ββ¦Codβ¦β¦fβ¦β¦
]β©β"
textβΉComponents.βΊ
lemma cf_eval_arrow_components:
shows "cf_eval_arrow β π fβ¦ArrValβ¦ =
(
Ξ»xββ©βπβ¦NTDomβ¦β¦ObjMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦.
πβ¦NTCodβ¦β¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦β¦ArrValβ¦β¦xβ¦β¦
)"
and "cf_eval_arrow β π fβ¦ArrDomβ¦ = πβ¦NTDomβ¦β¦ObjMapβ¦β¦ββ¦Domβ¦β¦fβ¦β¦"
and "cf_eval_arrow β π fβ¦ArrCodβ¦ = πβ¦NTCodβ¦β¦ObjMapβ¦β¦ββ¦Codβ¦β¦fβ¦β¦"
unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
context
fixes Ξ± π β π π a b f
assumes π: "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and f: "f : a β¦βββ b"
begin
interpretation π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π π π by (rule π)
lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
where β=β and π=βΉntcf_arrow πβΊ and f=f,
unfolded
ntcf_arrow_components
cf_map_components
π.NTDom.HomDom.cat_is_arrD[OF f]
cat_cs_simps
]
lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)
end
subsubsectionβΉArrow valueβΊ
context
fixes Ξ± π β π π a b f
assumes π: "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and f: "f : a β¦βββ b"
begin
mk_VLambda cf_eval_arrow_components'(1)[OF π f]
|vsv cf_eval_arrow_ArrVal_vsv[cat_cs_intros]|
|vdomain cf_eval_arrow_ArrVal_vdomain[cat_cs_simps]|
|app cf_eval_arrow_ArrVal_app[cat_cs_simps]|
end
subsubsectionβΉEvaluation arrow is an arrow in the category βΉSetβΊβΊ
lemma cf_eval_arrow_is_arr:
assumes "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "f : a β¦βββ b"
shows "cf_eval_arrow β (ntcf_arrow π) f :
πβ¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦bβ¦"
proof-
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π π π by (rule assms)
show ?thesis
proof
(
intro cat_Set_is_arrI arr_SetI,
unfold cf_eval_arrow_components'(2,3)[OF assms]
)
show "vfsequence (cf_eval_arrow β (ntcf_arrow π) f)"
unfolding cf_eval_arrow_def by simp
show "vcard (cf_eval_arrow β (ntcf_arrow π) f) = 3β©β"
unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
show "ββ©β (cf_eval_arrow β (ntcf_arrow π) fβ¦ArrValβ¦) ββ©β πβ¦ObjMapβ¦β¦bβ¦"
by
(
unfold cf_eval_arrow_components'[OF assms],
intro vrange_VLambda_vsubset
)
(
use assms in
βΉcs_concl cs_intro: cat_cs_intros cat_Set_cs_introsβΊ
)+
qed
(
use assms(2) in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ
)+
qed
lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
assumes "π' = ntcf_arrow π"
and "πa = πβ¦ObjMapβ¦β¦aβ¦"
and "πb = πβ¦ObjMapβ¦β¦bβ¦"
and "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "f : a β¦βββ b"
shows "cf_eval_arrow β π' f : πa β¦βcat_Set Ξ±β πb"
using assms(4,5) unfolding assms(1-3) by (rule cf_eval_arrow_is_arr)
lemma (in category) cat_cf_eval_arrow_ntcf_vcomp[cat_cs_simps]:
assumes "π : π β¦β©Cβ©F β : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "g : b β¦βββ c"
and "f : a β¦βββ b"
shows
"cf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f) =
cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f"
proof-
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π β π by (rule assms(1))
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π π π by (rule assms(2))
have ππ: "π ββ©Nβ©Tβ©Cβ©F π : π β¦β©Cβ©F β : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3,4) have gf: "g ββ©Aβββ f : a β¦βββ c"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from ππ gf have cf_eval_gf:
"cf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f) :
πβ¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ±β ββ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3,4) have cf_eval_g_cf_eval_f:
"cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f :
πβ¦ObjMapβ¦β¦aβ¦ β¦βcat_Set Ξ±β ββ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note cf_eval_gf = cf_eval_gf cat_Set_is_arrD[OF cf_eval_gf]
note cf_eval_g_cf_eval_f =
cf_eval_g_cf_eval_f cat_Set_is_arrD[OF cf_eval_g_cf_eval_f]
interpret arr_Set_cf_eval_gf:
arr_Set Ξ± βΉcf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f)βΊ
by (rule cf_eval_gf(2))
interpret arr_Set_cf_eval_g_cf_eval_f:
arr_Set
Ξ±
βΉ
cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f
βΊ
by (rule cf_eval_g_cf_eval_f(2))
show ?thesis
proof(rule arr_Set_eqI)
from ππ gf have dom_lhs:
"πβ©β (cf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f)β¦ArrValβ¦) =
πβ¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from cf_eval_g_cf_eval_f(1) have dom_rhs:
"πβ©β
(
(
cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f
)β¦ArrValβ¦
) = πβ¦ObjMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"cf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f)β¦ArrValβ¦ =
(
cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f
)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix πa assume prems: "πa ββ©β πβ¦ObjMapβ¦β¦aβ¦"
from
ArrVal_eq_helper
[
OF π.ntcf_Comp_commute[OF assms(4), symmetric],
where a=βΉπβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦πaβ¦βΊ
]
prems
assms(3,4)
have [cat_cs_simps]:
"ββ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦πaβ¦β¦β¦ =
πβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦πaβ¦β¦β¦"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
)
from prems assms(3,4) show
"cf_eval_arrow β (ntcf_arrow (π ββ©Nβ©Tβ©Cβ©F π)) (g ββ©Aβββ f)β¦ArrValβ¦β¦πaβ¦ =
(
cf_eval_arrow β (ntcf_arrow π) g ββ©Aβcat_Set Ξ±β
cf_eval_arrow β (ntcf_arrow π) f
)β¦ArrValβ¦β¦πaβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
)
qed (cs_concl cs_intro: V_cs_intros)
qed
(
auto
simp: cf_eval_gf cf_eval_g_cf_eval_f
intro: cf_eval_gf(2) cf_eval_g_cf_eval_f(2)
)
qed
lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_vcomp
lemma (in category) cat_cf_eval_arrow_ntcf_id[cat_cs_simps]:
assumes "π : β β¦β¦β©CβΞ±β cat_Set Ξ±" and "c ββ©β ββ¦Objβ¦"
shows
"cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦) =
cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms)
from assms(2) have ntcf_id_CId_c:
"cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦) :
πβ¦ObjMapβ¦β¦cβ¦ β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_intro: cat_cs_intros)
from assms(2) have CId_πc:
"cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦ : πβ¦ObjMapβ¦β¦cβ¦ β¦βcat_Set Ξ±β πβ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI[of Ξ±])
from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
"arr_Set Ξ± (cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦))"
by (auto dest: cat_Set_is_arrD(1))
from ntcf_id_CId_c have dom_lhs:
"πβ©β (cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦)β¦ArrValβ¦) =
πβ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_simp: cat_cs_simps)+
interpret ntcf_id_CId_c:
arr_Set Ξ± βΉcf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦)βΊ
by (rule arr_Set_ntcf_id_CId_c)
from CId_πc show arr_Set_CId_πc: "arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦)"
by (auto dest: cat_Set_is_arrD(1))
from CId_πc assms(2) have dom_rhs:
"πβ©β ((cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦)β¦ArrValβ¦) = πβ¦ObjMapβ¦β¦cβ¦"
by (cs_concl cs_simp: cat_cs_simps)
show
"cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦)β¦ArrValβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β πβ¦ObjMapβ¦β¦cβ¦"
with category_axioms assms(2) show
"cf_eval_arrow β (ntcf_arrow (ntcf_id π)) (ββ¦CIdβ¦β¦cβ¦)β¦ArrValβ¦β¦aβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦πβ¦ObjMapβ¦β¦cβ¦β¦β¦ArrValβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_πc in auto)
qed (use ntcf_id_CId_c CId_πc in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id
subsectionβΉβΉHOMβΊ-functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following definition is a technical generalization that is used
later in this section.
βΊ
definition cf_HOM_snd :: "V β V β V" (βΉHOMβ©CΔ±'(/,_-/')βΊ)
where "HOMβ©CβΞ±β(,π-) =
[
(Ξ»aββ©βop_cat (πβ¦HomCodβ¦)β¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±β(πβ¦HomCodβ¦)(a,-) ββ©Cβ©F π)),
(
Ξ»fββ©βop_cat (πβ¦HomCodβ¦)β¦Arrβ¦.
ntcf_arrow (Homβ©Aβ©.β©CβΞ±β(πβ¦HomCodβ¦)(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
),
op_cat (πβ¦HomCodβ¦),
cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)
]β©β"
definition cf_HOM_fst :: "V β V β V" (βΉHOMβ©CΔ±'(/_-,/')βΊ)
where "HOMβ©CβΞ±β(π-,) =
[
(Ξ»aββ©β(πβ¦HomCodβ¦)β¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±β(πβ¦HomCodβ¦)(-,a) ββ©Cβ©F op_cf π)),
(
Ξ»fββ©β(πβ¦HomCodβ¦)β¦Arrβ¦.
ntcf_arrow (Homβ©Aβ©.β©CβΞ±β(πβ¦HomCodβ¦)(-,f) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)
),
πβ¦HomCodβ¦,
cat_FUNCT Ξ± (op_cat (πβ¦HomDomβ¦)) (cat_Set Ξ±)
]β©β"
textβΉComponents.βΊ
lemma cf_HOM_snd_components:
shows "HOMβ©CβΞ±β(,π-)β¦ObjMapβ¦ =
(Ξ»aββ©βop_cat (πβ¦HomCodβ¦)β¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±β(πβ¦HomCodβ¦)(a,-) ββ©Cβ©F π))"
and "HOMβ©CβΞ±β(,π-)β¦ArrMapβ¦ =
(
Ξ»fββ©βop_cat (πβ¦HomCodβ¦)β¦Arrβ¦.
ntcf_arrow (Homβ©Aβ©.β©CβΞ±β(πβ¦HomCodβ¦)(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π)
)"
and [cat_cs_simps]: "HOMβ©CβΞ±β(,π-)β¦HomDomβ¦ = op_cat (πβ¦HomCodβ¦)"
and [cat_cs_simps]:
"HOMβ©CβΞ±β(,π-)β¦HomCodβ¦ = cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)"
unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)
lemma cf_HOM_fst_components:
shows "HOMβ©CβΞ±β(π-,)β¦ObjMapβ¦ =
(Ξ»aββ©β(πβ¦HomCodβ¦)β¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±β(πβ¦HomCodβ¦)(-,a) ββ©Cβ©F op_cf π))"
and "HOMβ©CβΞ±β(π-,)β¦ArrMapβ¦ =
(
Ξ»fββ©β(πβ¦HomCodβ¦)β¦Arrβ¦.
ntcf_arrow (Homβ©Aβ©.β©CβΞ±β(πβ¦HomCodβ¦)(-,f) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F op_cf π)
)"
and "HOMβ©CβΞ±β(π-,)β¦HomDomβ¦ = πβ¦HomCodβ¦"
and "HOMβ©CβΞ±β(π-,)β¦HomCodβ¦ = cat_FUNCT Ξ± (op_cat (πβ¦HomDomβ¦)) (cat_Set Ξ±)"
unfolding cf_HOM_fst_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas cf_HOM_snd_components' =
cf_HOM_snd_components[where π=π, unfolded cf_HomDom cf_HomCod]
lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
lemmas cf_HOM_fst_components' =
cf_HOM_fst_components[where π=π, unfolded cf_HomDom cf_HomCod]
lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)
end
subsubsectionβΉObject mapβΊ
mk_VLambda cf_HOM_snd_components(1)
|vsv cf_HOM_snd_ObjMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_snd_components'(1)[unfolded cat_op_simps]
|vdomain cf_HOM_snd_ObjMap_vdomain[cat_cs_simps]|
|app cf_HOM_snd_ObjMap_app[cat_cs_simps]|
mk_VLambda cf_HOM_snd_components(1)
|vsv cf_HOM_fst_ObjMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_fst_components'(1)[unfolded cat_op_simps]
|vdomain cf_HOM_fst_ObjMap_vdomain[cat_cs_simps]|
|app cf_HOM_fst_ObjMap_app[cat_cs_simps]|
subsubsectionβΉArrow mapβΊ
mk_VLambda cf_HOM_snd_components(2)
|vsv cf_HOM_snd_ArrMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_snd_components'(2)[unfolded cat_op_simps]
|vdomain cf_HOM_snd_ArrMap_vdomain[cat_cs_simps]|
|app cf_HOM_snd_ArrMap_app[cat_cs_simps]|
mk_VLambda cf_HOM_fst_components(2)
|vsv cf_HOM_fst_ArrMap_vsv[cat_cs_intros]|
mk_VLambda (in is_functor) cf_HOM_fst_components'(2)[unfolded cat_op_simps]
|vdomain cf_HOM_fst_ArrMap_vdomain[cat_cs_simps]|
|app cf_HOM_fst_ArrMap_app[cat_cs_simps]|
subsubsectionβΉOpposite βΉHOMβΊ-functorβΊ
lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]:
"HOMβ©CβΞ±β(,op_cf π-) = HOMβ©CβΞ±β(π-,)"
proof-
have dom_lhs: "πβ©β HOMβ©CβΞ±β(,op_cf π-) = 4β©β"
unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
have dom_rhs: "πβ©β HOMβ©CβΞ±β(π-,) = 4β©β"
unfolding cf_HOM_fst_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β 4β©β"
then show "HOMβ©CβΞ±β(,op_cf π-)β¦aβ¦ = HOMβ©CβΞ±β(π-,)β¦aβ¦"
proof
(
elim_in_numeral,
use nothing in βΉfold dghm_field_simps, unfold cat_cs_simpsβΊ
)
show "HOMβ©CβΞ±β(,op_cf π-)β¦ObjMapβ¦ = HOMβ©CβΞ±β(π-,)β¦ObjMapβ¦"
unfolding
cf_HOM_fst_components'
is_functor.cf_HOM_snd_components'[OF is_functor_op]
by (rule VLambda_eqI, unfold cat_op_simps)
(cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)+
show "HOMβ©CβΞ±β(,op_cf π-)β¦ArrMapβ¦ = HOMβ©CβΞ±β(π-,)β¦ArrMapβ¦"
unfolding
cf_HOM_fst_components'
is_functor.cf_HOM_snd_components'[OF is_functor_op]
by (rule VLambda_eqI, unfold cat_op_simps)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+
qed
(
auto simp:
cf_HOM_fst_components' cat_cs_simps cat_op_simps cat_op_intros
)
qed (auto simp: cf_HOM_snd_def cf_HOM_fst_def)
qed
lemmas [cat_op_simps] = is_functor.cf_HOM_snd_op
context is_functor
begin
lemmas cf_HOM_fst_op[cat_op_simps] =
is_functor.cf_HOM_snd_op[OF is_functor_op, unfolded cat_op_simps, symmetric]
end
lemmas [cat_op_simps] = is_functor.cf_HOM_fst_op
subsubsectionβΉβΉHOMβΊ-functor is a functorβΊ
lemma (in is_functor) cf_HOM_snd_is_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "HOMβ©CβΞ±β(,π-) : op_cat π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± π (cat_Set Ξ±)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²β: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
show ?thesis
proof(intro is_functorI', unfold cat_op_simps)
show "vfsequence HOMβ©CβΞ±β(,π-)" unfolding cf_HOM_snd_def by auto
show "vcard HOMβ©CβΞ±β(,π-) = 4β©β"
unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
show "ββ©β (HOMβ©CβΞ±β(,π-)β¦ObjMapβ¦) ββ©β cat_FUNCT Ξ± π (cat_Set Ξ±)β¦Objβ¦"
unfolding cf_HOM_snd_components'
proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
fix b assume prems: "b ββ©β π
β¦Objβ¦"
with assms(2) show
"cf_map (Homβ©Oβ©.β©CβΞ±βπ
(b,-) ββ©Cβ©F π) ββ©β cat_FUNCT Ξ± π (cat_Set Ξ±)β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
show
"HOMβ©CβΞ±β(,π-)β¦ArrMapβ¦β¦f ββ©Aβπ
β gβ¦ =
HOMβ©CβΞ±β(,π-)β¦ArrMapβ¦β¦gβ¦ ββ©Aβcat_FUNCT Ξ± π (cat_Set Ξ±)β
HOMβ©CβΞ±β(,π-)β¦ArrMapβ¦β¦fβ¦"
if "g : c β¦βπ
β b" and "f : b β¦βπ
β a" for b c g a f
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show
"HOMβ©CβΞ±β(,π-)β¦ArrMapβ¦β¦π
β¦CIdβ¦β¦cβ¦β¦ =
cat_FUNCT Ξ± π (cat_Set Ξ±)β¦CIdβ¦β¦HOMβ©CβΞ±β(,π-)β¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β π
β¦Objβ¦" for c
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed
(
use assms(2) in
βΉ
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
βΊ
)+
qed
lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "β' = op_cat π
"
and "π = cat_FUNCT Ξ± π (cat_Set Ξ±)"
shows "HOMβ©CβΞ±β(,π-) : β' β¦β¦β©CβΞ²β π"
using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_snd_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_HOM_snd_is_functor'
lemma (in is_functor) cf_HOM_fst_is_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "HOMβ©CβΞ±β(π-,) : π
β¦β¦β©CβΞ²β cat_FUNCT Ξ± (op_cat π) (cat_Set Ξ±)"
by
(
rule is_functor.cf_HOM_snd_is_functor[
OF is_functor_op assms, unfolded cat_op_simps
]
)
lemma (in is_functor) cf_HOM_fst_is_functor'[cat_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "β' = π
"
and "π = cat_FUNCT Ξ± (op_cat π) (cat_Set Ξ±)"
shows "HOMβ©CβΞ±β(π-,) : β' β¦β¦β©CβΞ²β π"
using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_fst_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_HOM_fst_is_functor'
subsectionβΉEvaluation functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.βΊ
definition cf_eval :: "V β V β V β V"
where "cf_eval Ξ± Ξ² β =
[
(Ξ»πdββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦. πdβ¦0β¦β¦ObjMapβ¦β¦πdβ¦1β©ββ¦β¦),
(
Ξ»πfββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Arrβ¦.
cf_eval_arrow β (πfβ¦0β¦) (πfβ¦1β©ββ¦)
),
cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β,
cat_Set Ξ²
]β©β"
textβΉComponents.βΊ
lemma cf_eval_components:
shows "cf_eval Ξ± Ξ² ββ¦ObjMapβ¦ =
(Ξ»πdββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦. πdβ¦0β¦β¦ObjMapβ¦β¦πdβ¦1β©ββ¦β¦)"
and "cf_eval Ξ± Ξ² ββ¦ArrMapβ¦ =
(
Ξ»πfββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Arrβ¦.
cf_eval_arrow β (πfβ¦0β¦) (πfβ¦1β©ββ¦)
)"
and [cat_cs_simps]:
"cf_eval Ξ± Ξ² ββ¦HomDomβ¦ = cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β"
and [cat_cs_simps]: "cf_eval Ξ± Ξ² ββ¦HomCodβ¦ = cat_Set Ξ²"
unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval Ξ± Ξ² ββ¦ObjMapβ¦)"
unfolding cf_eval_components by simp
lemma cf_eval_ObjMap_vdomain[cat_cs_simps]:
"πβ©β (cf_eval Ξ± Ξ² ββ¦ObjMapβ¦) = (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦"
unfolding cf_eval_components by simp
lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]:
assumes "πc = [cf_map π, c]β©β"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "c ββ©β ββ¦Objβ¦"
shows "cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πcβ¦ = πβ¦ObjMapβ¦β¦cβ¦"
proof-
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο π΅_def π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
note [cat_small_cs_intros] = cat_category_if_ge_Limit
from assms(2,3) Ξ±Ξ² have "πc ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_simp: assms(1) cat_FUNCT_components(1)
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show ?thesis
by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.cf_eval_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval Ξ± Ξ² ββ¦ArrMapβ¦)"
unfolding cf_eval_components by simp
lemma cf_eval_ArrMap_vdomain[cat_cs_simps]:
"πβ©β (cf_eval Ξ± Ξ² ββ¦ArrMapβ¦) = (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Arrβ¦"
unfolding cf_eval_components by simp
lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]:
assumes "πf = [ntcf_arrow π, f]β©β"
and "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "f : a β¦βββ b"
shows "cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦ = cf_eval_arrow β (ntcf_arrow π) f"
proof-
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π π π by (rule assms(2))
define Ξ² where "Ξ² = Ξ± + Ο"
have "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: Ξ²_def π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο π΅_def π΅_Ξ±_Ξ±Ο)
then interpret Ξ²: π΅ Ξ² by simp
note [cat_small_cs_intros] = cat_category_if_ge_Limit
from assms(1,3) Ξ±Ξ² have "πf ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Arrβ¦"
by
(
cs_concl
cs_simp: assms(1) cat_FUNCT_components(1)
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show ?thesis
by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.cf_eval_ArrMap_app
subsubsectionβΉEvaluation functor is a functorβΊ
lemma (in category) cat_cf_eval_is_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_eval Ξ± Ξ² β : cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT:
category Ξ² βΉ(cat_FUNCT Ξ± β (cat_Set Ξ±))βΊ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret Ξ²β: category Ξ² β
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret cat_Set_Ξ±Ξ²: subcategory Ξ² βΉcat_Set Ξ±βΊ βΉcat_Set Ξ²βΊ
by (rule subcategory_cat_Set_cat_Set[OF assms])
show ?thesis
proof(intro is_functorI')
show "vfsequence (cf_eval Ξ± Ξ² β)" unfolding cf_eval_def by simp
from cat_category_if_ge_Limit[OF assms] show
"category Ξ² ((cat_FUNCT Ξ± β (cat_Set Ξ±)) Γβ©C β)"
by (cs_concl cs_simp: cs_intro: cat_small_cs_intros cat_cs_intros)
show "vcard (cf_eval Ξ± Ξ² β) = 4β©β"
unfolding cf_eval_def by (simp add: nat_omega_simps)
show "ββ©β (cf_eval Ξ± Ξ² ββ¦ObjMapβ¦) ββ©β cat_Set Ξ²β¦Objβ¦"
proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
fix πc assume prems: "πc ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦"
then obtain π c
where πc_def: "πc = [π, c]β©β"
and π: "π ββ©β cf_maps Ξ± β (cat_Set Ξ±)"
and c: "c ββ©β ββ¦Objβ¦"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
intro: FUNCT.category_axioms Ξ²β.category_axioms
simp: cat_FUNCT_components(1)
)
from π obtain π where π_def: "π = cf_map π"
and π: "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (elim cf_mapsE)
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule π)
from π c show "cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πcβ¦ ββ©β cat_Set Ξ²β¦Objβ¦"
unfolding πc_def π_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Set_Ξ±Ξ².subcat_Obj_vsubset
)
qed (cs_concl cs_intro: cat_cs_intros)
show "cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦ :
cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πaβ¦ β¦βcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πbβ¦"
if πf: "πf : πa β¦βcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ πb" for πa πb πf
proof-
obtain π f π a π b
where πf_def: "πf = [π, f]β©β"
and πa_def: "πa = [π, a]β©β"
and πb_def: "πb = [π, b]β©β"
and π: "π : π β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β π"
and f: "f : a β¦βββ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF πf]
FUNCT.category_axioms
Ξ²β.category_axioms
)
note π = cat_FUNCT_is_arrD[OF π]
from π(1) f assms(2) show "cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦ :
cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πaβ¦ β¦βcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πbβ¦"
unfolding πf_def πa_def πb_def
by
(
intro cat_Set_Ξ±Ξ².subcat_is_arrD,
use nothing in βΉsubst π(2), subst π(3), subst π(4)βΊ
)
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros
)
qed
show
"cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πg ββ©Aβcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ πfβ¦ =
cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πgβ¦ ββ©Aβcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦"
if πg: "πg : πb β¦βcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ βc"
and πf: "πf : πa β¦βcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ πb"
for πf πg πa πb βc
proof-
obtain π f π a π b
where πf_def: "πf = [π, f]β©β"
and πa_def: "πa = [π, a]β©β"
and πb_def: "πb = [π, b]β©β"
and π: "π : π β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β π"
and f: "f : a β¦βββ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF πf]
FUNCT.category_axioms
Ξ²β.category_axioms
)
then obtain π g β c
where πg_def: "πg = [π, g]β©β"
and βc_def: "βc = [β, c]β©β"
and π: "π : π β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β β"
and g: "g : b β¦βββ c"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF πg]
FUNCT.category_axioms
Ξ²β.category_axioms
)
note π = cat_FUNCT_is_arrD[OF π]
and π = cat_FUNCT_is_arrD[OF π]
from π(1) π(1) f g show
"cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πg ββ©Aβcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ πfβ¦ =
cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πgβ¦ ββ©Aβcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦"
unfolding πg_def πf_def πa_def πb_def βc_def
by
(
subst (1 2) π(2), use nothing in βΉsubst (1 2) π(2)βΊ,
cs_concl_step cat_Set_Ξ±Ξ².subcat_Comp_simp[symmetric]
)
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
qed
show
"cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦CIdβ¦β¦πcβ¦β¦ =
cat_Set Ξ²β¦CIdβ¦β¦cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πcβ¦β¦"
if "πc ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦" for πc
proof-
from that obtain π c where πc_def: "πc = [π, c]β©β"
and π: "π ββ©β cf_maps Ξ± β (cat_Set Ξ±)"
and c: "c ββ©β ββ¦Objβ¦"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
intro: FUNCT.category_axioms Ξ²β.category_axioms
simp: cat_FUNCT_components(1)
)
from π obtain π where π_def: "π = cf_map π"
and π: "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (elim cf_mapsE)
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule π)
from π c show
"cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦CIdβ¦β¦πcβ¦β¦ =
cat_Set Ξ²β¦CIdβ¦β¦cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πcβ¦β¦"
unfolding πc_def π_def
by (cs_concl_step cat_Set_Ξ±Ξ².subcat_CId[symmetric])
(
cs_concl
cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma (in category) cat_cf_eval_is_functor':
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π' = cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β"
and "π
' = cat_Set Ξ²"
and "Ξ²' = Ξ²"
shows "cf_eval Ξ± Ξ² β : π' β¦β¦β©CβΞ²'β π
'"
using assms(1,2) unfolding assms(3-5) by (rule cat_cf_eval_is_functor)
lemmas [cat_cs_intros] = category.cat_cf_eval_is_functor'
subsectionβΉβΉNβΊ-functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.βΊ
definition cf_nt :: "V β V β V β V"
where "cf_nt Ξ± Ξ² π =
bifunctor_flip (πβ¦HomCodβ¦) (cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))"
textβΉAlternative definition.βΊ
lemma (in is_functor) cf_nt_def':
"cf_nt Ξ± Ξ² π =
bifunctor_flip π
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))"
unfolding cf_nt_def cf_HomDom cf_HomCod by simp
textβΉComponents.βΊ
lemma cf_nt_components:
shows "cf_nt Ξ± Ξ² πβ¦ObjMapβ¦ =
(
bifunctor_flip (πβ¦HomCodβ¦) (cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ObjMapβ¦"
and "cf_nt Ξ± Ξ² πβ¦ArrMapβ¦ =
(
bifunctor_flip (πβ¦HomCodβ¦) (cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ArrMapβ¦"
and "cf_nt Ξ± Ξ² πβ¦HomDomβ¦ =
(
bifunctor_flip (πβ¦HomCodβ¦) (cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦HomDomβ¦"
and "cf_nt Ξ± Ξ² πβ¦HomCodβ¦ =
(
bifunctor_flip (πβ¦HomCodβ¦) (cat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± (πβ¦HomDomβ¦) (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦HomCodβ¦"
unfolding cf_nt_def by simp_all
lemma (in is_functor) cf_nt_components':
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_nt Ξ± Ξ² πβ¦ObjMapβ¦ =
(
bifunctor_flip π
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ObjMapβ¦"
and "cf_nt Ξ± Ξ² πβ¦ArrMapβ¦ =
(
bifunctor_flip π
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ArrMapβ¦"
and [cat_cs_simps]:
"cf_nt Ξ± Ξ² πβ¦HomDomβ¦ = cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
"
and [cat_cs_simps]:
"cf_nt Ξ± Ξ² πβ¦HomCodβ¦ = cat_Set Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
show
"cf_nt Ξ± Ξ² πβ¦ObjMapβ¦ =
(
bifunctor_flip π
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ObjMapβ¦"
"cf_nt Ξ± Ξ² πβ¦ArrMapβ¦ =
(
bifunctor_flip π
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(Homβ©Oβ©.β©CβΞ²βcat_FUNCT Ξ± π (cat_Set Ξ±)(HOMβ©CβΞ±β(,π-)-,-))
)β¦ArrMapβ¦"
"cf_nt Ξ± Ξ² πβ¦HomDomβ¦ = cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
"
"cf_nt Ξ± Ξ² πβ¦HomCodβ¦ = cat_Set Ξ²"
unfolding cf_nt_def
using assms(2)
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)+
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_components'(3,4)
subsubsectionβΉObject mapβΊ
lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt Ξ± Ξ² ββ¦ObjMapβ¦)"
unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "πβ©β (cf_nt Ξ± Ξ² πβ¦ObjMapβ¦) = (cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
)β¦Objβ¦"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) show ?thesis
unfolding cf_nt_components
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_vdomain
lemma (in is_functor) cf_nt_ObjMap_app[cat_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "πb = [cf_map π, b]β©β"
and "π : π β¦β¦β©CβΞ±β cat_Set Ξ±"
and "b ββ©β π
β¦Objβ¦"
shows "cf_nt Ξ± Ξ² πβ¦ObjMapβ¦β¦πbβ¦ = Hom
(cat_FUNCT Ξ± π (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±βπ
(b,-) ββ©Cβ©F π))
(cf_map π)"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret π: is_functor Ξ± π βΉcat_Set Ξ±βΊ π by (rule assms(4))
from assms(2,5) show ?thesis
unfolding assms(3) cf_nt_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_app
subsubsectionβΉArrow mapβΊ
lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt Ξ± Ξ² ββ¦ArrMapβ¦)"
unfolding cf_nt_components by (cs_intro_step cat_cs_intros)
lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "πβ©β (cf_nt Ξ± Ξ² πβ¦ArrMapβ¦) = (cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
)β¦Arrβ¦"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) show ?thesis
unfolding cf_nt_components
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_vdomain
lemma (in is_functor) cf_nt_ArrMap_app[cat_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "πf = [ntcf_arrow π, f]β©β"
and "π : π β¦β©Cβ©F β : π β¦β¦β©CβΞ±β cat_Set Ξ±"
and "f : a β¦βπ
β b"
shows "cf_nt Ξ± Ξ² πβ¦ArrMapβ¦β¦πfβ¦ = cf_hom
(cat_FUNCT Ξ± π (cat_Set Ξ±))
[ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπ
(f,-) ββ©Nβ©Tβ©Cβ©Fβ©-β©Cβ©F π), ntcf_arrow π]β©β"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret π: is_ntcf Ξ± π βΉcat_Set Ξ±βΊ π β π by (rule assms(4))
from assms(2,5) show ?thesis
unfolding assms(3) cf_nt_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed
lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_app
subsubsectionβΉβΉNβΊ-functor is a functorβΊ
lemma (in is_functor) cf_nt_is_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "cf_nt Ξ± Ξ² π : cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²π: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret Ξ²π
: category Ξ² π
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) show ?thesis
unfolding cf_nt_def'
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
qed
lemma (in is_functor) cf_nt_is_functor':
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π' = cat_FUNCT Ξ± π (cat_Set Ξ±) Γβ©C π
"
and "π
' = cat_Set Ξ²"
and "Ξ²' = Ξ²"
shows "cf_nt Ξ± Ξ² π : π' β¦β¦β©CβΞ²'β π
'"
using assms(1,2) unfolding assms(3-5) by (rule cf_nt_is_functor)
lemmas [cat_cs_intros] = is_functor.cf_nt_is_functor'
subsectionβΉYoneda natural transformation arrowβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following subsection is based on the elements of the content
of Chapter III-2 in \cite{mac_lane_categories_2010}.
βΊ
definition ntcf_Yoneda_arrow :: "V β V β V β V β V"
where "ntcf_Yoneda_arrow Ξ± β π r =
[
(
Ξ»Οββ©βHom (cat_FUNCT Ξ± β (cat_Set Ξ±)) (cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-))) π.
Yoneda_map Ξ± (cf_of_cf_map β (cat_Set Ξ±) π) rβ¦
ntcf_of_ntcf_arrow β (cat_Set Ξ±) Ο
β¦
),
Hom (cat_FUNCT Ξ± β (cat_Set Ξ±)) (cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-))) π,
πβ¦ObjMapβ¦β¦rβ¦
]β©β"
textβΉComponentsβΊ
lemma ntcf_Yoneda_arrow_components:
shows "ntcf_Yoneda_arrow Ξ± β π rβ¦ArrValβ¦ =
(
Ξ»Οββ©βHom (cat_FUNCT Ξ± β (cat_Set Ξ±)) (cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-))) π.
Yoneda_map Ξ± (cf_of_cf_map β (cat_Set Ξ±) π) rβ¦
ntcf_of_ntcf_arrow β (cat_Set Ξ±) Ο
β¦
)"
and [cat_cs_simps]: "ntcf_Yoneda_arrow Ξ± β π rβ¦ArrDomβ¦ =
Hom (cat_FUNCT Ξ± β (cat_Set Ξ±)) (cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-))) π"
and [cat_cs_simps]: "ntcf_Yoneda_arrow Ξ± β π rβ¦ArrCodβ¦ = πβ¦ObjMapβ¦β¦rβ¦"
unfolding ntcf_Yoneda_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow mapβΊ
mk_VLambda ntcf_Yoneda_arrow_components(1)
|vsv ntcf_Yoneda_arrow_vsv[cat_cs_intros]|
|vdomain ntcf_Yoneda_arrow_vdomain[cat_cs_simps]|
context category
begin
context
fixes π :: V
begin
mk_VLambda ntcf_Yoneda_arrow_components(1)[where Ξ±=Ξ± and β=β and π=βΉcf_map πβΊ]
|app ntcf_Yoneda_arrow_app'|
lemmas ntcf_Yoneda_arrow_app =
ntcf_Yoneda_arrow_app'[unfolded in_Hom_iff, cat_cs_simps]
end
end
lemmas [cat_cs_simps] = category.ntcf_Yoneda_arrow_app
subsubsectionβΉSeveral technical lemmasβΊ
lemma (in vsv) vsv_vrange_VLambda_app:
assumes "g ` elts A = elts (πβ©β r)"
shows "ββ©β (Ξ»xββ©βA. rβ¦g xβ¦) = ββ©β r"
proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
show "(Ξ»xββ©βA. rβ¦g xβ¦)β¦xβ¦ ββ©β ββ©β r" if "x ββ©β A" for x
proof-
from assms that have "g x ββ©β πβ©β r" by auto
then have "rβ¦g xβ¦ ββ©β ββ©β r" by force
with that show ?thesis by simp
qed
show "rβ¦xβ¦ ββ©β ββ©β (Ξ»xββ©βA. rβ¦g xβ¦)" if "x ββ©β πβ©β r" for x
proof-
from that assms have "x β g ` elts A" by simp
then obtain c where c: "c ββ©β A" and x_def: "x = g c" by clarsimp
from c show ?thesis unfolding x_def by auto
qed
qed auto
lemma (in vsv) vsv_vrange_VLambda_app':
assumes "g ` elts A = elts (πβ©β r)"
and "R = ββ©β r"
shows "ββ©β (Ξ»xββ©βA. rβ¦g xβ¦) = R"
using assms(1) unfolding assms(2) by (rule vsv_vrange_VLambda_app)
lemma (in v11) v11_VLambda_v11_bij_betw_comp:
assumes "bij_betw g (elts A) (elts (πβ©β r))"
shows "v11 (Ξ»xββ©βA. rβ¦g xβ¦)"
proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
fix x y assume prems: "x ββ©β A" "y ββ©β A" "rβ¦g xβ¦ = rβ¦g yβ¦"
from assms prems(1,2) have "g x ββ©β πβ©β r" and "g y ββ©β πβ©β r" by auto
from v11_injective[OF this prems(3)] have "g x = g y".
with assms prems(1,2) show "x = y" unfolding bij_betw_def inj_on_def by simp
qed simp
subsubsectionβΉ
Yoneda natural transformation arrow is an arrow in the category βΉSetβΊ
βΊ
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
shows "ntcf_Yoneda_arrow Ξ± β (cf_map π) r :
Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-)))
(cf_map π) β¦β©iβ©sβ©oβcat_Set Ξ²β
πβ¦ObjMapβ¦β¦rβ¦"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms)
from assms(2) interpret FUNCT: tiny_category Ξ² βΉcat_FUNCT Ξ± β (cat_Set Ξ±)βΊ
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
let ?Hom_r = βΉHomβ©Oβ©.β©CβΞ±ββ(r,-)βΊ
from assms have [cat_cs_simps]: "cf_of_cf_map β (cat_Set Ξ±) (cf_map π) = π"
by (cs_concl cs_simp: cat_FUNCT_cs_simps)
note Yoneda = cat_Yoneda_Lemma[OF assms(3,4)]
show ?thesis
proof
(
intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
unfold cat_cs_simps cf_map_components
)
show "vfsequence (ntcf_Yoneda_arrow Ξ± β (cf_map π) r)"
unfolding ntcf_Yoneda_arrow_def by simp
show "vcard (ntcf_Yoneda_arrow Ξ± β (cf_map π) r) = 3β©β"
unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
show "ββ©β (ntcf_Yoneda_arrow Ξ± β (cf_map π) rβ¦ArrValβ¦) = πβ¦ObjMapβ¦β¦rβ¦"
unfolding cat_cs_simps cf_map_components ntcf_Yoneda_arrow_components
by (intro vsv.vsv_vrange_VLambda_app', unfold Yoneda(2))
(
use assms(4) in
βΉ
cs_concl
cs_simp:
cat_cs_simps bij_betwD(2)[OF bij_betw_ntcf_of_ntcf_arrow_Hom]
cs_intro: cat_cs_intros
βΊ
)+
then show "ββ©β (ntcf_Yoneda_arrow Ξ± β (cf_map π) rβ¦ArrValβ¦) ββ©β πβ¦ObjMapβ¦β¦rβ¦"
by auto
from assms(4) show "v11 (ntcf_Yoneda_arrow Ξ± β (cf_map π) rβ¦ArrValβ¦)"
unfolding ntcf_Yoneda_arrow_components
by
(
intro v11.v11_VLambda_v11_bij_betw_comp,
unfold cat_cs_simps π.Yoneda_map_vdomain;
intro Yoneda bij_betw_ntcf_of_ntcf_arrow_Hom
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(4) show
"Hom (cat_FUNCT Ξ± β (cat_Set Ξ±)) (cf_map ?Hom_r) (cf_map π) ββ©β Vset Ξ²"
by (intro FUNCT.cat_Hom_in_Vset)
(
cs_concl
cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from assms(4) have "πβ¦ObjMapβ¦β¦rβ¦ ββ©β Vset Ξ±"
by (cs_concl cs_intro: cat_cs_intros)
then show "πβ¦ObjMapβ¦β¦rβ¦ ββ©β Vset Ξ²"
by (auto simp: assms(2) Vset_trans Vset_in_mono)
qed (auto intro: cat_cs_intros)
qed
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism':
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π' = cf_map π"
and "B = πβ¦ObjMapβ¦β¦rβ¦"
and "A = Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-)))
(cf_map π)"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
shows "ntcf_Yoneda_arrow Ξ± β π' r : A β¦β©iβ©sβ©oβcat_Set Ξ²β B"
using assms(1,2,6,7)
unfolding assms(3-5)
by (rule cat_ntcf_Yoneda_arrow_is_arr_isomoprhism)
lemmas [cat_arrow_cs_intros] =
category.cat_ntcf_Yoneda_arrow_is_arr_isomoprhism'
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
shows "ntcf_Yoneda_arrow Ξ± β (cf_map π) r :
Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-)))
(cf_map π) β¦βcat_Set Ξ²β
πβ¦ObjMapβ¦β¦rβ¦"
by
(
rule cat_Set_is_arr_isomorphismD[
OF cat_ntcf_Yoneda_arrow_is_arr_isomoprhism[OF assms]
]
)
lemma (in category) cat_ntcf_Yoneda_arrow_is_arr'[cat_cs_intros]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π' = cf_map π"
and "B = πβ¦ObjMapβ¦β¦rβ¦"
and "A = Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(r,-)))
(cf_map π)"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
shows "ntcf_Yoneda_arrow Ξ± β π' r : A β¦βcat_Set Ξ²β B"
using assms(1,2,6,7)
unfolding assms(3-5)
by (rule cat_ntcf_Yoneda_arrow_is_arr)
lemmas [cat_arrow_cs_intros] = category.cat_ntcf_Yoneda_arrow_is_arr'
subsectionβΉCommutativity law for the Yoneda natural transformation arrowβΊ
lemma (in category) cat_ntcf_Yoneda_arrow_commutativity:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "π : π β¦β©Cβ©F π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "f : a β¦βββ b"
shows
"ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β
cf_hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
[ntcf_arrow Homβ©Aβ©.β©CβΞ±ββ(f,-), ntcf_arrow π]β©β =
cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a"
proof-
let ?hom =
βΉ
cf_hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
[ntcf_arrow Homβ©Aβ©.β©CβΞ±ββ(f,-), ntcf_arrow π]β©β
βΊ
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ π π π by (rule assms(3))
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
interpret Ξ²β: category Ξ² β
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
interpret cat_Set_Ξ±Ξ²: subcategory Ξ² βΉcat_Set Ξ±βΊ βΉcat_Set Ξ²βΊ
by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
from assms(2,4) have πb_πf:
"ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?hom :
Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(a,-)))
(cf_map π) β¦βcat_Set Ξ²β
πβ¦ObjMapβ¦β¦bβ¦"
by
(
cs_concl
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
cat_FUNCT_cs_intros
)
from assms(2,4) have πf_πa:
"cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a :
Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(a,-)))
(cf_map π) β¦βcat_Set Ξ²β
πβ¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_intro: cat_cs_intros cat_Set_Ξ±Ξ².subcat_is_arrD)
show ?thesis
proof(rule arr_Set_eqI[of Ξ²])
from πb_πf show arr_Set_πb_πf:
"arr_Set Ξ² (ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?hom)"
by (auto dest: cat_Set_is_arrD(1))
from πb_πf have dom_lhs:
"πβ©β ((ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?hom)β¦ArrValβ¦) =
Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(a,-)))
(cf_map π)"
by (cs_concl cs_simp: cat_cs_simps)+
interpret πf_πa: arr_Set
Ξ² βΉntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?homβΊ
by (rule arr_Set_πb_πf)
from πf_πa show arr_Set_πf_πa:
"arr_Set
Ξ²
(
cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a
)"
by (auto dest: cat_Set_is_arrD(1))
from πf_πa have dom_rhs:
"πβ©β
(
(
cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a
)β¦ArrValβ¦
) = Hom
(cat_FUNCT Ξ± β (cat_Set Ξ±))
(cf_map (Homβ©Oβ©.β©CβΞ±ββ(a,-)))
(cf_map π)"
by (cs_concl cs_simp: cat_cs_simps)
show
"(ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?hom)β¦ArrValβ¦ =
(
cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a
)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix π assume prems:
"π : cf_map Homβ©Oβ©.β©CβΞ±ββ(a,-) β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β cf_map π"
from assms(4) have [cat_cs_simps]:
"cf_of_cf_map β (cat_Set Ξ±) (cf_map Homβ©Oβ©.β©CβΞ±ββ(a,-)) = Homβ©Oβ©.β©CβΞ±ββ(a,-)"
"cf_of_cf_map β (cat_Set Ξ±) (cf_map π) = π"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note π = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
interpret π: is_ntcf
Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(a,-)βΊ π βΉntcf_of_ntcf_arrow β (cat_Set Ξ±) πβΊ
by (rule π(1))
have ππ_eq_ππ:
"πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦Aβ¦β¦ =
πβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦Aβ¦β¦"
if "A ββ©β πβ¦ObjMapβ¦β¦aβ¦" for A
using
ArrVal_eq_helper[
OF π.ntcf_Comp_commute[OF assms(4), symmetric], where a=A
]
assms(4)
that
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from π(1) assms(2,3,4) have πa_CId_a:
"πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦ββ¦CIdβ¦β¦aβ¦β¦ ββ©β πβ¦ObjMapβ¦β¦aβ¦"
by (subst π)
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_Set_cs_intros cat_cs_intros
)
have πf_πa_eq_πb:
"πβ¦ArrMapβ¦β¦fβ¦β¦ArrValβ¦β¦πβ¦NTMapβ¦β¦aβ¦β¦ArrValβ¦β¦hβ¦β¦ =
πβ¦NTMapβ¦β¦bβ¦β¦ArrValβ¦β¦f ββ©Aβββ hβ¦"
if "h : a β¦βββ a" for h
using
ArrVal_eq_helper[
OF π.ntcf_Comp_commute[OF assms(4), symmetric], where a=h
]
that
assms(4)
category_axioms
by
(
cs_prems
cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from π(1) assms(2,3,4) πa_CId_a category_axioms show
"(ntcf_Yoneda_arrow Ξ± β (cf_map π) b ββ©Aβcat_Set Ξ²β ?hom)β¦ArrValβ¦β¦πβ¦ =
(
cf_eval_arrow β (ntcf_arrow π) f ββ©Aβcat_Set Ξ²β
ntcf_Yoneda_arrow Ξ± β (cf_map π) a
)β¦ArrValβ¦β¦πβ¦"
by (subst (1 2) π(2))
(
cs_concl
cs_simp:
πf_πa_eq_πb ππ_eq_ππ
cat_FUNCT_cs_simps
cat_cs_simps
cat_op_simps
cs_intro:
cat_Set_Ξ±Ξ².subcat_is_arrD
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)+
qed (use arr_Set_πb_πf arr_Set_πf_πa in auto)
qed (use πb_πf πf_πa in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
subsectionβΉYoneda Lemma: naturalityβΊ
subsubsectionβΉ
The Yoneda natural transformation: definition and elementary properties
βΊ
textβΉ
The main result of this subsection corresponds to the corollary to the
Yoneda Lemma on page 61 in \cite{mac_lane_categories_2010}.
βΊ
definition ntcf_Yoneda :: "V β V β V β V"
where "ntcf_Yoneda Ξ± Ξ² β =
[
(
Ξ»πrββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦.
ntcf_Yoneda_arrow Ξ± β (πrβ¦0β¦) (πrβ¦1β©ββ¦)
),
cf_nt Ξ± Ξ² (cf_id β),
cf_eval Ξ± Ξ² β,
cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β,
cat_Set Ξ²
]β©β"
textβΉComponents.βΊ
lemma ntcf_Yoneda_components:
shows "ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦ =
(
Ξ»πrββ©β(cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦.
ntcf_Yoneda_arrow Ξ± β (πrβ¦0β¦) (πrβ¦1β©ββ¦)
)"
and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ββ¦NTDomβ¦ = cf_nt Ξ± Ξ² (cf_id β)"
and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ββ¦NTCodβ¦ = cf_eval Ξ± Ξ² β"
and [cat_cs_simps]:
"ntcf_Yoneda Ξ± Ξ² ββ¦NTDGDomβ¦ = cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β"
and [cat_cs_simps]: "ntcf_Yoneda Ξ± Ξ² ββ¦NTDGCodβ¦ = cat_Set Ξ²"
unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda ntcf_Yoneda_components(1)
|vsv ntcf_Yoneda_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_Yoneda_NTMap_vdomain[cat_cs_intros]|
lemma (in category) ntcf_Yoneda_NTMap_app[cat_cs_simps]:
assumes "π΅ Ξ²"
and "Ξ± ββ©β Ξ²"
and "πr = [cf_map π, r]β©β"
and "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "r ββ©β ββ¦Objβ¦"
shows "ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦πrβ¦ = ntcf_Yoneda_arrow Ξ± β (cf_map π) r"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret π: is_functor Ξ± β βΉcat_Set Ξ±βΊ π by (rule assms(4))
interpret Ξ²β: category Ξ² β
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) interpret FUNCT: category Ξ² βΉcat_FUNCT Ξ± β (cat_Set Ξ±)βΊ
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
from assms(5) have "[cf_map π, r]β©β ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
then show ?thesis
unfolding assms(3) ntcf_Yoneda_components by (simp add: nat_omega_simps)
qed
lemmas [cat_cs_simps] = category.ntcf_Yoneda_NTMap_app
subsubsectionβΉThe Yoneda natural transformation is a natural transformationβΊ
lemma (in category) cat_ntcf_Yoneda_is_ntcf:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "ntcf_Yoneda Ξ± Ξ² β :
cf_nt Ξ± Ξ² (cf_id β) β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_eval Ξ± Ξ² β :
cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β β¦β¦β©CβΞ²β cat_Set Ξ²"
proof-
interpret Ξ²: π΅ Ξ² by (rule assms(1))
interpret Ξ²β: category Ξ² β
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in βΉcs_concl cs_intro: cat_cs_introsβΊ)+
from assms(2) interpret FUNCT: category Ξ² βΉcat_FUNCT Ξ± β (cat_Set Ξ±)βΊ
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence (ntcf_Yoneda Ξ± Ξ² β)" unfolding ntcf_Yoneda_def by simp
show "vcard (ntcf_Yoneda Ξ± Ξ² β) = 5β©β"
unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
show ntcf_Yoneda_πr: "ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦πrβ¦ :
cf_nt Ξ± Ξ² (cf_id β)β¦ObjMapβ¦β¦πrβ¦ β¦β©iβ©sβ©oβcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πrβ¦"
if "πr ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦" for πr
proof-
from that obtain π r
where πr_def: "πr = [π, r]β©β"
and π: "π ββ©β cf_maps Ξ± β (cat_Set Ξ±)"
and r: "r ββ©β ββ¦Objβ¦"
by
(
auto
elim: cat_prod_2_ObjE[rotated 2]
simp: cat_FUNCT_cs_simps
intro: cat_cs_intros
)
from π obtain π
where π_def: "π = cf_map π" and π: "π : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by clarsimp
from assms(2) π r show ?thesis
unfolding πr_def π_def
by
(
cs_concl!
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
)
qed
show "ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦πrβ¦ :
cf_nt Ξ± Ξ² (cf_id β)β¦ObjMapβ¦β¦πrβ¦ β¦βcat_Set Ξ²β cf_eval Ξ± Ξ² ββ¦ObjMapβ¦β¦πrβ¦"
if "πr ββ©β (cat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C β)β¦Objβ¦" for πr
by (rule is_arr_isomorphismD[OF ntcf_Yoneda_πr[OF that]])
show
"ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦πbβ¦ ββ©Aβcat_Set Ξ²β
cf_nt Ξ± Ξ² (cf_id β)β¦ArrMapβ¦β¦πfβ¦ =
cf_eval Ξ± Ξ² ββ¦ArrMapβ¦β¦πfβ¦ ββ©Aβcat_Set Ξ²β
ntcf_Yoneda Ξ± Ξ² ββ¦NTMapβ¦β¦πaβ¦"
if πf: "πf : πa β¦βcat_FUNCT Ξ± β (cat_Set Ξ±) Γβ©C ββ πb" for πa πb πf
proof-
obtain π f π a π b
where πf_def: "πf = [π, f]β©β"
and πa_def: "πa = [π, a]β©β"
and πb_def: "πb = [π, b]β©β"
and π: "π : π β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β π"
and f: "f : a β¦βββ b"
by
(
auto intro:
cat_prod_2_is_arrE[rotated 2, OF πf]
FUNCT.category_axioms
Ξ²β.category_axioms
)
note π = cat_FUNCT_is_arrD[OF π]
note [cat_cs_simps] =
cat_ntcf_Yoneda_arrow_commutativity[OF assms π(1) f, folded π(2,3,4)]
from π(1) assms(2) f show ?thesis
unfolding πf_def πa_def πb_def
by (subst (1 2) π(2), use nothing in βΉsubst π(3), subst π(4)βΊ)
(
cs_concl
cs_simp: π(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
)+
qed
qed (use assms(2) in βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ)+
qed
subsectionβΉβΉHomβΊ-mapβΊ
textβΉ
This subsection presents some of the results stated as Corollary 2
in subsection 1.15 in \cite{bodo_categories_1970} and the corollary
following the statement of the Yoneda Lemma on
page 61 in \cite{mac_lane_categories_2010} in a variety of forms.
βΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following function makes an explicit appearance in subsection 1.15 in
\cite{bodo_categories_1970}.
βΊ
definition ntcf_Hom_map :: "V β V β V β V β V"
where "ntcf_Hom_map Ξ± β a b = (Ξ»fββ©βHom β a b. Homβ©Aβ©.β©CβΞ±ββ(f,-))"
textβΉElementary properties.βΊ
mk_VLambda ntcf_Hom_map_def
|vsv ntcf_Hom_map_vsv|
|vdomain ntcf_Hom_map_vdomain[cat_cs_simps]|
|app ntcf_Hom_map_app[unfolded in_Hom_iff, cat_cs_simps]|
subsubsectionβΉβΉHomβΊ-map is a bijectionβΊ
lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦ : s β¦βββ r"
and "π = Homβ©Aβ©.β©CβΞ±ββ(Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦,-)"
and "βf. β¦ f ββ©β ββ¦Arrβ¦; π = Homβ©Aβ©.β©CβΞ±ββ(f,-) β§ βΉ
f = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦"
proof-
interpret π: is_ntcf Ξ± β βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(r,-)βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(s,-)βΊ π
by (rule assms(3))
let ?Y_Hom_s = βΉYoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβΊ
note Yoneda =
cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
interpret Y: v11 βΉ?Y_Hom_sβΊ by (rule Yoneda(1))
from category_axioms assms have π_in_vdomain: "π ββ©β πβ©β (?Y_Hom_s)"
by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros)
then have "?Y_Hom_sβ¦πβ¦ ββ©β ββ©β (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
from this category_axioms assms show Ym_π: "?Y_Hom_sβ¦πβ¦ : s β¦βββ r"
unfolding Yoneda(2)
by (cs_prems_step cs_simp: cat_cs_simps cat_op_simps)+ simp
then have "?Y_Hom_sβ¦πβ¦ ββ©β ββ¦Arrβ¦" by (simp add: cat_cs_intros)
have "Homβ©Aβ©.β©CβΞ±ββ(?Y_Hom_sβ¦πβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (intro cat_ntcf_Hom_snd_is_ntcf Ym_π)
from assms Ym_π this category_axioms assms have
"(?Y_Hom_s)Β―β©ββ¦?Y_Hom_sβ¦πβ¦β¦ =
Yoneda_arrow Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) r (?Y_Hom_sβ¦πβ¦)"
by (intro category.inv_Yoneda_map_app)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
then have "(?Y_Hom_s)Β―β©ββ¦?Y_Hom_sβ¦πβ¦β¦ = Homβ©Aβ©.β©CβΞ±ββ(?Y_Hom_sβ¦πβ¦,-)"
by (simp add: ntcf_Hom_snd_def'[OF Ym_π])
with π_in_vdomain show "π = Homβ©Aβ©.β©CβΞ±ββ(?Y_Hom_sβ¦πβ¦,-)" by auto
fix f assume prems: "f ββ©β ββ¦Arrβ¦" "π = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
then obtain a b where f: "f : a β¦βββ b" by auto
have "π : Homβ©Oβ©.β©CβΞ±ββ(b,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
with f π.ntcf_NTDom π.ntcf_NTCod assms cat_is_arrD(2,3)[OF f]
have ba_simps: "b = r" "a = s"
by
(
simp_all add:
prems(2) cat_cf_Hom_snd_inj cat_ntcf_Hom_snd_components(2,3)
)
from f have "f : s β¦βββ r" unfolding ba_simps .
with category_axioms show "f = ?Y_Hom_sβ¦πβ¦"
unfolding prems(2) by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
qed
lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique:
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦ : r β¦βββ s"
and "π = Homβ©Aβ©.β©CβΞ±ββ(-,Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦)"
and "βf. β¦ f ββ©β ββ¦Arrβ¦; π = Homβ©Aβ©.β©CβΞ±ββ(-,f) β§ βΉ
f = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦"
by
(
intro
category.cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[
OF category_op,
unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd,
OF assms(1,2),
unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
OF assms(3)
]
)+
lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique':
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "β!f. f ββ©β ββ¦Arrβ¦ β§ π = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
using cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms] by blast
lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique':
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "β!f. f ββ©β ββ¦Arrβ¦ β§ π = Homβ©Aβ©.β©CβΞ±ββ(-,f)"
using cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique[OF assms] by blast
lemma (in category) cat_ntcf_Hom_snd_inj:
assumes "Homβ©Aβ©.β©CβΞ±ββ(g,-) = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
and "g : a β¦βββ b"
and "f : a β¦βββ b"
shows "g = f"
proof-
from assms have
"Yoneda_map Ξ± (Homβ©Oβ©.β©CβΞ±ββ(a,-)) bβ¦Homβ©Aβ©.β©CβΞ±ββ(g,-)β¦ =
Yoneda_map Ξ± (Homβ©Oβ©.β©CβΞ±ββ(a,-)) bβ¦Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦"
by simp
from this assms category_axioms show "g = f"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
simp
qed
lemma (in category) cat_ntcf_Hom_fst_inj:
assumes "Homβ©Aβ©.β©CβΞ±ββ(-,g) = Homβ©Aβ©.β©CβΞ±ββ(-,f)"
and "g : a β¦βββ b"
and "f : a β¦βββ b"
shows "g = f"
proof-
from category.cat_ntcf_Hom_snd_inj
[
OF category_op,
unfolded cat_op_simps,
unfolded cat_op_cat_ntcf_Hom_snd,
OF assms
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_map:
assumes "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "v11 (ntcf_Hom_map Ξ± β a b)"
and "ββ©β (ntcf_Hom_map Ξ± β a b) =
these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-)"
and "(ntcf_Hom_map Ξ± β a b)Β―β©β =
(Ξ»πββ©βthese_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-).
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦)"
proof-
show "v11 (ntcf_Hom_map Ξ± β a b)"
proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
show "vsv (ntcf_Hom_map Ξ± β a b)" unfolding ntcf_Hom_map_def by simp
fix g f assume prems:
"g : a β¦βββ b"
"f : a β¦βββ b"
"ntcf_Hom_map Ξ± β a bβ¦gβ¦ = ntcf_Hom_map Ξ± β a bβ¦fβ¦"
from prems(3,1,2) have "Homβ©Aβ©.β©CβΞ±ββ(g,-) = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
with prems(1,2) show "g = f" by (intro cat_ntcf_Hom_snd_inj[of g f])
qed
then interpret Hm: v11 βΉntcf_Hom_map Ξ± β a bβΊ .
show Hm_vrange: "ββ©β (ntcf_Hom_map Ξ± β a b) =
these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-)"
proof(intro vsubset_antisym)
show "ββ©β (ntcf_Hom_map Ξ± β a b) ββ©β
these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-)"
by
(
unfold ntcf_Hom_map_def,
intro vrange_VLambda_vsubset,
unfold these_ntcfs_iff in_Hom_iff,
intro cat_ntcf_Hom_snd_is_ntcf
)
show "these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-) ββ©β
ββ©β (ntcf_Hom_map Ξ± β a b)"
proof(intro vsubsetI, unfold these_ntcfs_iff)
fix π assume prems:
"π : Homβ©Oβ©.β©CβΞ±ββ(b,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
note unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
from unique(1) have
"Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦ ββ©β πβ©β (ntcf_Hom_map Ξ± β a b)"
by (cs_concl cs_simp: cat_cs_simps)
moreover from
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF assms(2,1) prems]
have π_def: "π = ntcf_Hom_map Ξ± β a bβ¦Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦β¦"
by (cs_concl cs_simp: cat_cs_simps)
ultimately show "π ββ©β ββ©β (ntcf_Hom_map Ξ± β a b)" by force
qed
qed
show "(ntcf_Hom_map Ξ± β a b)Β―β©β =
(
Ξ»πββ©βthese_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-).
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦
)"
proof
(
rule vsv_eqI,
unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
)
from Hm.v11_axioms show "vsv ((ntcf_Hom_map Ξ± β a b)Β―β©β)" by auto
show "vsv
(
Ξ»πββ©βthese_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-).
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦
)"
by simp
fix π assume prems:
"π : Homβ©Oβ©.β©CβΞ±ββ(b,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
then have π:
"π ββ©β these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-)"
unfolding these_ntcfs_iff by simp
show "(ntcf_Hom_map Ξ± β a b)Β―β©ββ¦πβ¦ =
(
Ξ»πββ©βthese_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-).
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦
)β¦πβ¦"
proof
(
intro Hm.v11_vconverse_app,
unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF π]
)
note unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
show "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦ : a β¦βββ b" by (rule unique(1))
then show
"ntcf_Hom_map Ξ± β a bβ¦Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦β¦ = π"
by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
qed
qed simp
qed
subsubsectionβΉInverse of a βΉHomβΊ-mapβΊ
lemma (in category) inv_ntcf_Hom_map_v11:
assumes "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "v11 ((ntcf_Hom_map Ξ± β a b)Β―β©β)"
using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_ntcf_Hom_map_vdomain:
assumes "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "πβ©β ((ntcf_Hom_map Ξ± β a b)Β―β©β) =
these_ntcfs Ξ± β (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(b,-) Homβ©Oβ©.β©CβΞ±ββ(a,-)"
unfolding cat_ntcf_Hom_map(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_vdomain
lemma (in category) inv_ntcf_Hom_map_app:
assumes "a ββ©β ββ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(b,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(a,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "(ntcf_Hom_map Ξ± β a b)Β―β©ββ¦πβ¦ = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(a,-) bβ¦πβ¦"
using assms(3) unfolding cat_ntcf_Hom_map(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_app
lemma inv_ntcf_Hom_map_vrange: "ββ©β ((ntcf_Hom_map Ξ± β a b)Β―β©β) = Hom β a b"
unfolding ntcf_Hom_map_def by simp
subsubsectionβΉβΉHomβΊ-natural transformation and isomorphismsβΊ
textβΉ
This subsection presents further results that were stated
as Corollary 2 in subsection 1.15 in \cite{bodo_categories_1970}.
βΊ
lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf:
assumes "f : s β¦β©iβ©sβ©oβββ r"
shows "Homβ©Aβ©.β©CβΞ±ββ(f,-) :
Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from assms obtain g
where iso_g: "g : r β¦β©iβ©sβ©oβββ s"
and gf: "g ββ©Aβββ f = ββ¦CIdβ¦β¦sβ¦"
and fg: "f ββ©Aβββ g = ββ¦CIdβ¦β¦rβ¦"
by
(
auto intro:
cat_the_inverse_Comp_CId_left
cat_the_inverse_Comp_CId_right
cat_the_inverse_is_arr_isomorphism'
)
then have g: "g : r β¦βββ s" by auto
show ?thesis
proof(intro is_arr_isomorphism_is_iso_ntcf)
from assms have f: "f : s β¦βββ r" by auto
with category_axioms show "Homβ©Aβ©.β©CβΞ±ββ(f,-) :
Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms g show "Homβ©Aβ©.β©CβΞ±ββ(g,-) :
Homβ©Oβ©.β©CβΞ±ββ(s,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(r,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms f g have
"Homβ©Aβ©.β©CβΞ±ββ(f,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(g,-) = Homβ©Aβ©.β©CβΞ±ββ(g ββ©Aβββ f,-)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms f g have "β¦ = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(s,-)"
by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
finally show
"Homβ©Aβ©.β©CβΞ±ββ(f,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(g,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(s,-)"
by simp
from category_axioms f g have
"Homβ©Aβ©.β©CβΞ±ββ(g,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(f,-) = Homβ©Aβ©.β©CβΞ±ββ(f ββ©Aβββ g,-)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from category_axioms f g have "β¦ = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(r,-)"
by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
finally show
"Homβ©Aβ©.β©CβΞ±ββ(g,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(f,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(r,-)"
by simp
qed
qed
lemma (in category) cat_is_arr_isomorphism_ntcf_Hom_fst_is_iso_ntcf:
assumes "f : r β¦β©iβ©sβ©oβββ s"
shows "Homβ©Aβ©.β©CβΞ±ββ(-,f) :
Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
from assms have r: "r ββ©β ββ¦Objβ¦" and s: "s ββ©β ββ¦Objβ¦" by auto
from
category.cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf
[
OF category_op,
unfolded cat_op_simps,
OF assms,
unfolded
category.cat_op_cat_cf_Hom_snd[OF category_axioms r]
category.cat_op_cat_cf_Hom_snd[OF category_axioms s]
category.cat_op_cat_ntcf_Hom_snd[OF category_axioms]
]
show ?thesis.
qed
lemma (in category) cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique:
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦ : s β¦β©iβ©sβ©oβββ r"
and "π = Homβ©Aβ©.β©CβΞ±ββ(Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦,-)"
and "βf. β¦ f ββ©β ββ¦Arrβ¦; π = Homβ©Aβ©.β©CβΞ±ββ(f,-) β§ βΉ
f = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦"
proof-
let ?Ym_π = βΉYoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦βΊ
and ?Ym_inv_π = βΉYoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(r,-) sβ¦inv_ntcf πβ¦βΊ
from assms(3) have π:
"π : Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by auto
from iso_ntcf_is_arr_isomorphism[OF assms(3)]
have iso_inv_π: "inv_ntcf π :
Homβ©Oβ©.β©CβΞ±ββ(s,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(r,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
and [simp]: "π ββ©Nβ©Tβ©Cβ©F inv_ntcf π = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(s,-)"
and [simp]: "inv_ntcf π ββ©Nβ©Tβ©Cβ©F π = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(r,-)"
by auto
from iso_inv_π have inv_π:
"inv_ntcf π : Homβ©Oβ©.β©CβΞ±ββ(s,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(r,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by auto
note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) π]
and inv_unique =
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_π]
have Ym_π: "?Ym_π : s β¦βββ r" by (rule unique(1))
show "π = Homβ©Aβ©.β©CβΞ±ββ(Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦,-)"
and "βf. β¦ f ββ©β ββ¦Arrβ¦; π = Homβ©Aβ©.β©CβΞ±ββ(f,-) β§ βΉ
f = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦"
by (intro unique)+
show "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦πβ¦ : s β¦β©iβ©sβ©oβββ r"
proof(intro is_arr_isomorphismI[OF Ym_π, of βΉ?Ym_inv_πβΊ] is_inverseI)
show Ym_inv_π: "?Ym_inv_π : r β¦βββ s" by (rule inv_unique(1))
have "ntcf_id Homβ©Oβ©.β©CβΞ±ββ(s,-) = π ββ©Nβ©Tβ©Cβ©F inv_ntcf π" by simp
also have "β¦ = Homβ©Aβ©.β©CβΞ±ββ(?Ym_π,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(?Ym_inv_π,-)"
by (subst unique(2), subst inv_unique(2)) simp
also from category_axioms Ym_π inv_unique(1) assms(3) have
"β¦ = Homβ©Aβ©.β©CβΞ±ββ(?Ym_inv_π ββ©Aβββ ?Ym_π,-)"
by (cs_concl cs_simp: cat_cs_simps)
finally have "Homβ©Aβ©.β©CβΞ±ββ(?Ym_inv_π ββ©Aβββ ?Ym_π,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(s,-)"
by simp
also from category_axioms assms(1,2) have "β¦ = Homβ©Aβ©.β©CβΞ±ββ(ββ¦CIdβ¦β¦sβ¦,-)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have "Homβ©Aβ©.β©CβΞ±ββ(?Ym_inv_π ββ©Aβββ ?Ym_π,-) = Homβ©Aβ©.β©CβΞ±ββ(ββ¦CIdβ¦β¦sβ¦,-)"
by simp
then show "?Ym_inv_π ββ©Aβββ ?Ym_π = ββ¦CIdβ¦β¦sβ¦"
by (rule cat_ntcf_Hom_snd_inj)
(
allβΉ
use category_axioms Ym_π Ym_inv_π assms in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ
βΊ
)
have "ntcf_id Homβ©Oβ©.β©CβΞ±ββ(r,-) = inv_ntcf π ββ©Nβ©Tβ©Cβ©F π" by simp
also have "β¦ = Homβ©Aβ©.β©CβΞ±ββ(?Ym_inv_π,-) ββ©Nβ©Tβ©Cβ©F Homβ©Aβ©.β©CβΞ±ββ(?Ym_π,-)"
by (subst unique(2), subst inv_unique(2)) simp
also from category_axioms Ym_π inv_unique(1) have
"β¦ = Homβ©Aβ©.β©CβΞ±ββ(?Ym_π ββ©Aβββ ?Ym_inv_π,-)"
by (cs_concl cs_simp: cat_cs_simps)
finally have
"Homβ©Aβ©.β©CβΞ±ββ(?Ym_π ββ©Aβββ ?Ym_inv_π,-) = ntcf_id Homβ©Oβ©.β©CβΞ±ββ(r,-)"
by simp
also from category_axioms assms(1,2) have "β¦ = Homβ©Aβ©.β©CβΞ±ββ(ββ¦CIdβ¦β¦rβ¦,-)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have
"Homβ©Aβ©.β©CβΞ±ββ(?Ym_π ββ©Aβββ ?Ym_inv_π,-) = Homβ©Aβ©.β©CβΞ±ββ(ββ¦CIdβ¦β¦rβ¦,-)"
by simp
then show "?Ym_π ββ©Aβββ ?Ym_inv_π = ββ¦CIdβ¦β¦rβ¦"
by (rule cat_ntcf_Hom_snd_inj)
(
allβΉ
use category_axioms Ym_π Ym_inv_π assms in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβΊ
βΊ
)
qed (intro Ym_π)
qed
lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
assumes "r ββ©β ββ¦Objβ¦"
and "s ββ©β ββ¦Objβ¦"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦ : r β¦β©iβ©sβ©oβββ s"
and "π = Homβ©Aβ©.β©CβΞ±ββ(-,Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦)"
and "βf. β¦ f ββ©β ββ¦Arrβ¦; π = Homβ©Aβ©.β©CβΞ±ββ(-,f) β§ βΉ
f = Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦πβ¦"
by
(
intro
category.cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[
OF category_op,
unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd,
OF assms(1,2),
unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
OF assms(3)
]
)+
lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf:
assumes "f : s β¦βββ r"
and "Homβ©Aβ©.β©CβΞ±ββ(f,-) :
Homβ©Oβ©.β©CβΞ±ββ(r,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(s,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "f : s β¦β©iβ©sβ©oβββ r"
proof-
from assms(1) have r: "r ββ©β ββ¦Objβ¦" and s: "s ββ©β ββ¦Objβ¦" by auto
note unique = cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[OF r s assms(2)]
from unique(1) have Ym_Hf:
"Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(s,-) rβ¦Homβ©Aβ©.β©CβΞ±ββ(f,-)β¦ : s β¦βββ r"
by auto
from unique(1) show ?thesis
unfolding cat_ntcf_Hom_snd_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
by simp
qed
lemma (in category) cat_is_arr_isomorphism_if_ntcf_Hom_fst_is_iso_ntcf:
assumes "f : r β¦βββ s"
and "Homβ©Aβ©.β©CβΞ±ββ(-,f) :
Homβ©Oβ©.β©CβΞ±ββ(-,r) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(-,s) : op_cat β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "f : r β¦β©iβ©sβ©oβββ s"
proof-
from assms(1) have r: "r ββ©β ββ¦Objβ¦" and s: "s ββ©β ββ¦Objβ¦" by auto
note unique = cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique[OF r s assms(2)]
from unique(1) have Ym_Hf:
"Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(-,s) rβ¦Homβ©Aβ©.β©CβΞ±ββ(-,f)β¦ : r β¦βββ s"
by auto
from unique(1) show ?thesis
unfolding cat_ntcf_Hom_fst_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
by simp
qed
subsubsectionβΉ
The relationship between a βΉHomβΊ-natural transformation and the compositions
of a βΉHomβΊ-natural transformation and a natural transformation
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-)β¦NTMapβ¦β¦b, cβ¦β©β = Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦β¦cβ¦"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from assms(2) have b: "b ββ©β π
β¦Objβ¦" unfolding cat_op_simps by simp
from category_axioms assms(1,3) b show ?thesis
by
(
cs_concl
cs_simp:
cat_ntcf_lcomp_Hom_component_is_Yoneda_component cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
lemma (in category) cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F = Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
show ?thesis
proof(rule ntcf_eqI[of Ξ±])
from category_axioms assms show
"Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
from assms this have dom_lhs:
"πβ©β ((Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms show
"Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms this have dom_rhs:
"πβ©β (Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦) = ββ¦Objβ¦"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"(Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦ =
Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ββ©β ββ¦Objβ¦"
with category_axioms assms show
"(Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F)β¦NTMapβ¦β¦aβ¦ =
Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦β¦aβ¦"
by (cs_concl cs_simp: cat_cs_simps)
qed (use assms(2) in βΉauto intro: cat_cs_introsβΊ)
qed simp_all
qed
lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd
subsubsectionβΉ
The relationship between the βΉHomβΊ-natural isomorphisms and the compositions
of a βΉHomβΊ-natural isomorphism and a natural transformation
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "βb. b ββ©β π
β¦Objβ¦ βΉ Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
have "Homβ©Aβ©.β©CβΞ±β(Ο-,-)βop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±ββ(π-,-)βop_cat π
,ββ(b,-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o
Homβ©Oβ©.β©CβΞ±ββ(π-,-)βop_cat π
,ββ(b,-)β©Cβ©F :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
if "b ββ©β π
β¦Objβ¦" for b
unfolding
cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1) that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο.NTDom.is_functor_axioms that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο.NTCod.is_functor_axioms that]
by (intro assms(2) that)
from
is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
OF
Ο.NTDom.HomDom.category_op category_axioms
cat_ntcf_lcomp_Hom_is_ntcf[OF assms(1)],
unfolded cat_op_simps, OF this
]
show ?thesis .
qed
lemma (in category) cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf:
assumes "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
and "Homβ©Aβ©.β©CβΞ±β(Ο-,-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "b ββ©β π
β¦Objβ¦"
shows "Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule assms(1))
from category_axioms assms show ?thesis
by
(
fold
cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1,3)]
cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο.NTDom.is_functor_axioms assms(3)]
cat_cf_lcomp_Hom_cf_Hom_snd[OF Ο.NTCod.is_functor_axioms assms(3)],
intro bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf
)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed
subsectionβΉYoneda map for arbitrary functorsβΊ
textβΉ
The concept of the Yoneda map for arbitrary functors was developed based
on the function that was used in the statement of Lemma 3 in
subsection 1.15 in \cite{bodo_categories_1970}.
βΊ
definition af_Yoneda_map :: "V β V β V β V"
where "af_Yoneda_map Ξ± π π =
(Ξ»Οββ©βthese_ntcfs Ξ± (πβ¦HomDomβ¦) (πβ¦HomCodβ¦) π π. Homβ©Aβ©.β©CβΞ±β(Ο-,-))"
textβΉElementary properties.βΊ
context
fixes Ξ± π
β π π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
and π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda
af_Yoneda_map_def[where π=π and π=π, unfolded π.cf_HomDom π.cf_HomCod]
|vsv af_Yoneda_map_vsv|
|vdomain af_Yoneda_map_vdomain[cat_cs_simps]|
|app af_Yoneda_map_app[unfolded these_ntcfs_iff, cat_cs_simps]|
end
subsectionβΉYoneda arrow for arbitrary functorsβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
The following natural transformation is used in the proof of Lemma 3 in
subsection 1.15 in \cite{bodo_categories_1970}.
βΊ
definition af_Yoneda_arrow :: "V β V β V β V β V"
where "af_Yoneda_arrow Ξ± π π π =
[
(
Ξ»bββ©β(πβ¦HomDomβ¦)β¦Objβ¦.
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(πβ¦ObjMapβ¦β¦bβ¦,-) (πβ¦ObjMapβ¦β¦bβ¦)β¦
πβop_cat (πβ¦HomDomβ¦),πβ¦HomCodβ¦β(b,-)β©Nβ©Tβ©Cβ©F
β¦
),
π,
π,
πβ¦HomDomβ¦,
πβ¦HomCodβ¦
]β©β"
textβΉComponents.βΊ
lemma af_Yoneda_arrow_components:
shows "af_Yoneda_arrow Ξ± π π πβ¦NTMapβ¦ =
(
Ξ»bββ©βπβ¦HomDomβ¦β¦Objβ¦.
Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±βπβ¦HomCodβ¦(πβ¦ObjMapβ¦β¦bβ¦,-) (πβ¦ObjMapβ¦β¦bβ¦)β¦
πβop_cat (πβ¦HomDomβ¦),πβ¦HomCodβ¦β(b,-)β©Nβ©Tβ©Cβ©F
β¦
)"
and "af_Yoneda_arrow Ξ± π π πβ¦NTDomβ¦ = π"
and "af_Yoneda_arrow Ξ± π π πβ¦NTCodβ¦ = π"
and "af_Yoneda_arrow Ξ± π π πβ¦NTDGDomβ¦ = πβ¦HomDomβ¦"
and "af_Yoneda_arrow Ξ± π π πβ¦NTDGCodβ¦ = πβ¦HomCodβ¦"
unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda af_Yoneda_arrow_components(1)
|vsv af_Yoneda_arrow_NTMap_vsv|
context
fixes Ξ± π
β π
assumes π: "π : π
β¦β¦β©CβΞ±β β"
begin
interpretation π: is_functor Ξ± π
β π by (rule π)
mk_VLambda
af_Yoneda_arrow_components(1)[where π=π, unfolded π.cf_HomDom π.cf_HomCod]
|vdomain af_Yoneda_arrow_NTMap_vdomain[cat_cs_simps]|
|app af_Yoneda_arrow_NTMap_app[cat_cs_simps]|
end
lemma (in category) cat_af_Yoneda_arrow_is_ntcf:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "af_Yoneda_arrow Ξ± π π π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
proof-
let ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Set = βΉcat_Set Ξ±βΊ
and ?Ym =
βΉ
Ξ»b. Yoneda_map
Ξ± Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) (πβ¦ObjMapβ¦β¦bβ¦)β¦πβop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©Fβ¦
βΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_ntcf
Ξ± βΉop_cat π
Γβ©C ββΊ βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ π
by (rule assms)
have comm[unfolded cat_op_simps]:
"(πβ¦NTMapβ¦ β¦c, dβ¦β©β)β¦ArrValβ¦β¦f ββ©Aβββ (q ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦)β¦ =
f ββ©Aβββ ((πβ¦NTMapβ¦ β¦a, bβ¦β©β)β¦ArrValβ¦β¦qβ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦)"
if "g : a β¦βop_cat π
β c" and "f : b β¦βββ d" and "q : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ b"
for q g f a b c d
proof-
from that(1) have g: "g : c β¦βπ
β a" unfolding cat_op_simps by simp
from category_axioms assms g that(2) have ab:
"[a, b]β©β ββ©β (op_cat π
Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from π.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have πab:
"πβ¦NTMapβ¦β¦a, bβ¦β©β :
Hom β (πβ¦ObjMapβ¦β¦aβ¦) b β¦βcat_Set Ξ±β Hom β (πβ¦ObjMapβ¦β¦aβ¦) b"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
have π_abq: "(πβ¦NTMapβ¦β¦a, bβ¦β©β)β¦ArrValβ¦β¦qβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βββ b"
by
(
rule cat_Set_ArrVal_app_vrange[
OF πab, unfolded in_Hom_iff, OF that(3)
]
)
have "[g, f]β©β : [a, b]β©β β¦βop_cat π
Γβ©C ββ [c, d]β©β"
by
(
rule
cat_prod_2_is_arrI[
OF π.HomDom.category_op category_axioms that(1,2)
]
)
then have
"πβ¦NTMapβ¦β¦c, dβ¦β©β ββ©Aβcat_Set Ξ±β Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦β¦g, fβ¦β©β =
Homβ©Oβ©.β©CβΞ±ββ(π-,-)β¦ArrMapβ¦β¦g, fβ¦β©β ββ©Aβcat_Set Ξ±β πβ¦NTMapβ¦β¦a, bβ¦β©β"
by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
then have
"(πβ¦NTMapβ¦β¦c, dβ¦β©β ββ©Aβ?Setβ ?Hπβ¦ArrMapβ¦β¦g, fβ¦β©β)β¦ArrValβ¦β¦qβ¦ =
(?Hπβ¦ArrMapβ¦β¦g, fβ¦β©β ββ©Aβ?Setβ πβ¦NTMapβ¦β¦a, bβ¦β©β)β¦ArrValβ¦β¦qβ¦"
by auto
from
this that(2,3) assms
category_axioms π.HomDom.category_axioms π.HomDom.category_op category_op
g πab π_abq
show
"(πβ¦NTMapβ¦β¦c, dβ¦β©β)β¦ArrValβ¦β¦f ββ©Aβββ (q ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦)β¦ =
f ββ©Aβββ ((πβ¦NTMapβ¦β¦a, bβ¦β©β)β¦ArrValβ¦β¦qβ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦gβ¦)"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (af_Yoneda_arrow Ξ± π π π)"
unfolding af_Yoneda_arrow_def by simp
show "vcard (af_Yoneda_arrow Ξ± π π π) = 5β©β"
unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)
have πb: "πβop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
if "b ββ©β π
β¦Objβ¦" for b
by
(
rule
bnt_proj_snd_is_ntcf
[
OF π.HomDom.category_op category_axioms assms(3),
unfolded cat_op_simps,
OF that,
unfolded
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) that]
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) that]
]
)
show "af_Yoneda_arrow Ξ± π π πβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
if "b ββ©β π
β¦Objβ¦" for b
proof-
let ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ
and ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ
and ?βπb = βΉββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦bβ¦β¦βΊ
from that have βπb: "?βπb : ?πb β¦βββ ?πb" by (auto simp: cat_cs_intros)
from assms that have "[b, ?πb]β©β ββ©β (op_cat π
Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from π.ntcf_NTMap_is_arr[OF this] category_axioms assms that have π_bπb:
"πβ¦NTMapβ¦β¦b, ?πbβ¦β©β : Hom β ?πb ?πb β¦βcat_Set Ξ±β Hom β ?πb ?πb"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from βπb have π_bπb_βπb:
"(πβ¦NTMapβ¦β¦b, ?πbβ¦β©β)β¦ArrValβ¦β¦?βπbβ¦ : ?πb β¦βββ ?πb"
by (rule cat_Set_ArrVal_app_vrange[OF π_bπb, unfolded in_Hom_iff])
with category_axioms assms that πb[OF that] show ?thesis
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
qed
show
"af_Yoneda_arrow Ξ± π π πβ¦NTMapβ¦β¦bβ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦fβ¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ af_Yoneda_arrow Ξ± π π πβ¦NTMapβ¦β¦aβ¦"
if "f : a β¦βπ
β b" for a b f
proof-
from that have a: "a ββ©β π
β¦Objβ¦" and b: "b ββ©β π
β¦Objβ¦" by auto
let ?π
a = βΉπ
β¦CIdβ¦β¦aβ¦βΊ
and ?π
b = βΉπ
β¦CIdβ¦β¦bβ¦βΊ
and ?πa = βΉπβ¦ObjMapβ¦β¦aβ¦βΊ
and ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ
and ?πa = βΉπβ¦ObjMapβ¦β¦aβ¦βΊ
and ?πb = βΉπβ¦ObjMapβ¦β¦bβ¦βΊ
and ?βπa = βΉββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦aβ¦β¦βΊ
and ?βπb = βΉββ¦CIdβ¦β¦πβ¦ObjMapβ¦β¦bβ¦β¦βΊ
from that have βπa: "?βπa : ?πa β¦βββ ?πa" by (auto intro: cat_cs_intros)
from that have βπb: "?βπb : ?πb β¦βββ ?πb" by (auto intro: cat_cs_intros)
from that have π
a: "?π
a : a β¦βπ
β a" by (auto intro: cat_cs_intros)
from assms that have "[b, ?πb]β©β ββ©β (op_cat π
Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from π.ntcf_NTMap_is_arr[OF this] category_axioms assms that have π_bπb:
"πβ¦NTMapβ¦β¦b, ?πbβ¦β©β : Hom β ?πb ?πb β¦βcat_Set Ξ±β Hom β ?πb ?πb"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from βπb have π_bπb_βπb:
"(πβ¦NTMapβ¦β¦b, ?πbβ¦β©β)β¦ArrValβ¦β¦?βπbβ¦ : ?πb β¦βββ ?πb"
by (rule cat_Set_ArrVal_app_vrange[OF π_bπb, unfolded in_Hom_iff])
from assms that have "[a, ?πa]β©β ββ©β (op_cat π
Γβ©C β)β¦Objβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
from π.ntcf_NTMap_is_arr[OF this] category_axioms assms that have π_aπa:
"πβ¦NTMapβ¦β¦a, ?πaβ¦β©β : Hom β ?πa ?πa β¦βcat_Set Ξ±β Hom β ?πa ?πa"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
from βπa have π_aπa_βπa:
"(πβ¦NTMapβ¦β¦a, ?πaβ¦β©β)β¦ArrValβ¦β¦?βπaβ¦ : ?πa β¦βββ ?πa"
by (rule cat_Set_ArrVal_app_vrange[OF π_aπa, unfolded in_Hom_iff])
from
comm[OF π
a π.cf_ArrMap_is_arr[OF that] βπa]
category_axioms assms that π_aπa_βπa
have π_a_πb[symmetric, cat_cs_simps]:
"(πβ¦NTMapβ¦β¦a, ?πbβ¦β©β)β¦ArrValβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ =
πβ¦ArrMapβ¦β¦fβ¦ ββ©Aβββ (πβ¦NTMapβ¦β¦a, ?πaβ¦β©β)β¦ArrValβ¦β¦?βπaβ¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from comm[OF that βπb βπb] category_axioms assms that π_bπb_βπb
have π_a_πb'[cat_cs_simps]:
"(πβ¦NTMapβ¦β¦a, ?πbβ¦β©β)β¦ArrValβ¦β¦πβ¦ArrMapβ¦β¦fβ¦β¦ =
(πβ¦NTMapβ¦β¦b, ?πbβ¦β©β)β¦ArrValβ¦β¦?βπbβ¦ ββ©Aβββ πβ¦ArrMapβ¦β¦fβ¦"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from category_axioms assms that πb[OF a] πb[OF b] show ?thesis
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
qed
qed (auto simp: af_Yoneda_arrow_components cat_cs_simps intro: cat_cs_intros)
qed
lemma (in category) cat_af_Yoneda_arrow_is_ntcf':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "Ξ² = Ξ±"
and "π' = π"
and "π' = π"
shows "af_Yoneda_arrow Ξ± π π π : π' β¦β©Cβ©F π' : π
β¦β¦β©CβΞ²β β"
using assms(1-3) unfolding assms(4-6) by (rule cat_af_Yoneda_arrow_is_ntcf)
lemmas [cat_cs_intros] = category.cat_af_Yoneda_arrow_is_ntcf'
subsubsectionβΉYoneda Lemma for arbitrary functorsβΊ
textβΉ
The following lemmas correspond to variants of the elements of Lemma 3
in subsection 1.15 in \cite{bodo_categories_1970}.
βΊ
lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "π = Homβ©Aβ©.β©CβΞ±β(af_Yoneda_arrow Ξ± π π π-,-)"
proof-
let ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?aYa = βΉΞ»π. af_Yoneda_arrow Ξ± π π πβΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_ntcf Ξ± βΉop_cat π
Γβ©C ββΊ βΉcat_Set Ξ±βΊ βΉ?HπβΊ βΉ?HπβΊ π
by (rule assms(3))
interpret aYπ: is_ntcf Ξ± π
β π π βΉ?aYa πβΊ
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
interpret HYπ: is_ntcf
Ξ± βΉop_cat π
Γβ©C ββΊ βΉcat_Set Ξ±βΊ βΉ?HπβΊ βΉ?HπβΊ βΉHomβ©Aβ©.β©CβΞ±β(?aYa π-,-)βΊ
by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aYπ.is_ntcf_axioms])
show [cat_cs_simps]: "π = Homβ©Aβ©.β©CβΞ±β(?aYa π-,-)"
proof
(
rule sym,
rule ntcf_eqI[OF HYπ.is_ntcf_axioms assms(3)],
rule vsv_eqI;
(intro HYπ.NTMap.vsv_axioms π.NTMap.vsv_axioms)?;
(unfold π.ntcf_NTMap_vdomain HYπ.ntcf_NTMap_vdomain)?
)
fix bc assume prems': "bc ββ©β (op_cat π
Γβ©C β)β¦Objβ¦"
then obtain b c
where bc_def: "bc = [b, c]β©β"
and op_b: "b ββ©β op_cat π
β¦Objβ¦"
and c: "c ββ©β ββ¦Objβ¦"
by (auto intro: cat_prod_2_ObjE cat_cs_intros)
from op_b have b: "b ββ©β π
β¦Objβ¦" unfolding cat_op_simps by simp
then have πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦" and πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
by (auto intro: cat_cs_intros)
have Ym_π:
"Yoneda_map Ξ± Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) (πβ¦ObjMapβ¦β¦bβ¦)β¦
πβop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F
β¦ = ?aYa πβ¦NTMapβ¦β¦bβ¦"
unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp
from
bnt_proj_snd_is_ntcf
[
OF π.HomDom.category_op category_axioms assms(3) op_b,
unfolded
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) b]
cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) b]
]
have πb: "πβop_cat π
,ββ(b,-)β©Nβ©Tβ©Cβ©F :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
by simp
from c show "Homβ©Aβ©.β©CβΞ±β(?aYa π-,-)β¦NTMapβ¦β¦bcβ¦ = πβ¦NTMapβ¦β¦bcβ¦"
unfolding
bc_def
cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aYπ.is_ntcf_axioms b c]
cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
OF πb πb πb, unfolded Ym_π, symmetric
]
by (cs_concl cs_simp: cat_cs_simps)
qed simp_all
qed
lemma (in category) cat_af_Yoneda_Lemma:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "v11 (af_Yoneda_map Ξ± π π)"
and "ββ©β (af_Yoneda_map Ξ± π π) =
these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(π-,-) Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
and "(af_Yoneda_map Ξ± π π)Β―β©β =
(
Ξ»πββ©βthese_ntcfs
Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(π-,-) Homβ©Oβ©.β©CβΞ±ββ(π-,-).
af_Yoneda_arrow Ξ± π π π
)"
proof-
let ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?aYm = βΉaf_Yoneda_map Ξ± π πβΊ
and ?aYa = βΉΞ»π. af_Yoneda_arrow Ξ± π π πβΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
show v11_aY: "v11 ?aYm"
proof
(
intro vsv.vsv_valeq_v11I,
unfold af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
)
show "vsv (af_Yoneda_map Ξ± π π)" by (rule af_Yoneda_map_vsv[OF assms])
fix Ο Ο assume prems:
"Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
"Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
"?aYmβ¦Οβ¦ = ?aYmβ¦Οβ¦"
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule prems(1))
interpret Ο: is_ntcf Ξ± π
β π π Ο by (rule prems(2))
from prems(3) have HΟ_HΟ: "Homβ©Aβ©.β©CβΞ±β(Ο-,-) = Homβ©Aβ©.β©CβΞ±β(Ο-,-)"
unfolding
af_Yoneda_map_app[OF assms prems(1)]
af_Yoneda_map_app[OF assms prems(2)]
by simp
show "Ο = Ο"
proof
(
rule ntcf_eqI[OF prems(1,2)],
rule vsv_eqI,
unfold Ο.ntcf_NTMap_vdomain Ο.ntcf_NTMap_vdomain
)
fix b assume prems': "b ββ©β π
β¦Objβ¦"
from prems' have Οb: "Οβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and Οb: "Οβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
and πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
and πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
by (auto intro: cat_cs_intros cat_prod_cs_intros)
have "Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-) = Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)"
proof
(
rule
ntcf_eqI
[
OF
cat_ntcf_Hom_snd_is_ntcf[OF Οb]
cat_ntcf_Hom_snd_is_ntcf[OF Οb]
]
)
show "Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦ = Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦"
proof
(
rule vsv_eqI,
unfold
ntcf_Hom_snd_NTMap_vdomain[OF Οb]
ntcf_Hom_snd_NTMap_vdomain[OF Οb]
)
fix c assume prems'': "c ββ©β ββ¦Objβ¦"
note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
show
"Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦β¦cβ¦ =
Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-)β¦NTMapβ¦β¦cβ¦"
unfolding
H[OF prems(1) prems' prems'', symmetric]
H[OF prems(2) prems' prems'', symmetric]
HΟ_HΟ
by simp
qed
(
simp_all add:
ntcf_Hom_snd_NTMap_vsv[OF Οb] ntcf_Hom_snd_NTMap_vsv[OF Οb]
)
qed simp_all
with Οb Οb show "Οβ¦NTMapβ¦β¦bβ¦ = Οβ¦NTMapβ¦β¦bβ¦"
by (auto intro: cat_ntcf_Hom_snd_inj)
qed auto
qed
interpret aYm: v11 ?aYm by (rule v11_aY)
have [cat_cs_simps]: "?aYmβ¦?aYa πβ¦ = π"
if "π : ?Hπ β¦β©Cβ©F ?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±" for π
using category_axioms assms that
by
(
cs_concl
cs_simp:
cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric] cat_cs_simps
cs_intro: cat_cs_intros
)
show aYm_vrange:
"ββ©β ?aYm = these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ"
proof(intro vsubset_antisym)
show "ββ©β ?aYm ββ©β these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
)
fix Ο assume "Ο : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
with category_axioms assms show
"?aYmβ¦Οβ¦ : ?Hπ β¦β©Cβ©F ?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: af_Yoneda_map_vsv)
show "these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ ββ©β ββ©β ?aYm"
proof(rule vsubsetI, unfold these_ntcfs_iff)
fix π assume prems:
"π : ?Hπ β¦β©Cβ©F ?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
interpret aYπ: is_ntcf Ξ± π
β π π βΉ?aYa πβΊ
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
from prems have π_def: "π = ?aYmβ¦?aYa πβ¦"
by (cs_concl cs_simp: cat_cs_simps)
from assms aYπ.is_ntcf_axioms have "?aYa π ββ©β πβ©β ?aYm"
by (cs_concl cs_simp: these_ntcfs_iff cat_cs_simps)
then show "π ββ©β ββ©β ?aYm" by (subst π_def, intro aYm.vsv_vimageI2) auto
qed
qed
show "?aYmΒ―β©β =
(Ξ»πββ©βthese_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ. ?aYa π)"
proof
(
rule vsv_eqI,
unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
)
from aYm.v11_axioms show "vsv ((af_Yoneda_map Ξ± π π)Β―β©β)" by auto
fix π assume prems: "π : ?Hπ β¦β©Cβ©F ?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
then have π: "π ββ©β these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ"
by simp
show "?aYmΒ―β©ββ¦πβ¦ =
(Ξ»πββ©βthese_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) ?Hπ ?Hπ. ?aYa π)β¦πβ¦"
proof
(
intro aYm.v11_vconverse_app,
unfold beta[OF π] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
)
from prems show π_def: "?aYmβ¦?aYa πβ¦ = π"
by (cs_concl cs_simp: cat_cs_simps)
show "?aYa π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
qed
qed simp_all
qed
subsubsectionβΉInverse of the Yoneda map for arbitrary functorsβΊ
lemma (in category) inv_af_Yoneda_map_v11:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "v11 ((af_Yoneda_map Ξ± π π)Β―β©β)"
using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)
lemma (in category) inv_af_Yoneda_map_vdomain:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "πβ©β ((af_Yoneda_map Ξ± π π)Β―β©β) =
these_ntcfs Ξ± (op_cat π
Γβ©C β) (cat_Set Ξ±) Homβ©Oβ©.β©CβΞ±ββ(π-,-) Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
unfolding cat_af_Yoneda_Lemma(3)[OF assms] by simp
lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_vdomain
lemma (in category) inv_af_Yoneda_map_app:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "(af_Yoneda_map Ξ± π π)Β―β©ββ¦πβ¦ = af_Yoneda_arrow Ξ± π π π"
using assms(3) unfolding cat_af_Yoneda_Lemma(3)[OF assms(1,2)] by simp
lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_app
lemma (in category) inv_af_Yoneda_map_vrange:
assumes "π : π
β¦β¦β©CβΞ±β β" and "π : π
β¦β¦β©CβΞ±β β"
shows "ββ©β ((af_Yoneda_map Ξ± π π)Β―β©β) = these_ntcfs Ξ± π
β π π"
proof-
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
from assms show ?thesis
unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
qed
subsubsectionβΉYoneda map for arbitrary functors and natural isomorphismsβΊ
textβΉ
The following lemmas correspond to variants of the elements of
Lemma 3 in subsection 1.15 in \cite{bodo_categories_1970}.
βΊ
lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
assumes "Ο : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
β¦β¦β©CβΞ±β β"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
proof-
interpret Ο: is_iso_ntcf Ξ± π
β π π Ο by (rule assms(1))
show ?thesis
proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
fix b assume "b ββ©β π
β¦Objβ¦"
then show "Homβ©Aβ©.β©CβΞ±ββ(Οβ¦NTMapβ¦β¦bβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
by
(
auto intro!:
cat_is_arr_isomorphism_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
)
qed (auto simp: cat_cs_intros)
qed
lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf':
assumes "Ο : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
β¦β¦β©CβΞ±β β"
and "Ξ² = Ξ±"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
and "π' = Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
and "π
' = op_cat π
Γβ©C β"
and "β' = cat_Set Ξ±"
shows "Homβ©Aβ©.β©CβΞ±β(Ο-,-) : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π
' β¦β¦β©CβΞ²β β'"
using assms(1)
unfolding assms(2-6)
by (rule cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf)
lemmas [cat_cs_intros] =
category.cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf'
lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
shows "af_Yoneda_arrow Ξ± π π π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
β¦β¦β©CβΞ±β β"
proof-
let ?aYa = βΉaf_Yoneda_arrow Ξ± π π πβΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
interpret π: is_iso_ntcf
Ξ± βΉop_cat π
Γβ©C ββΊ βΉcat_Set Ξ±βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ π
by (rule assms(3))
from assms(1,2) π.is_ntcf_axioms have π_def: "π = Homβ©Aβ©.β©CβΞ±β(?aYa-,-)"
by (cs_concl cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric])
from category_axioms assms have aYa: "?aYa : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_intro: cat_cs_intros)
have Hom_aYa: "Homβ©Aβ©.β©CβΞ±β(?aYa-,-) :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (auto intro: assms(3) simp add: π_def[symmetric])
have Hb:
"Homβ©Aβ©.β©CβΞ±ββ(?aYaβ¦NTMapβ¦β¦bβ¦,-) :
Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(πβ¦ObjMapβ¦β¦bβ¦,-) :
β β¦β¦β©CβΞ±β cat_Set Ξ±"
if "b ββ©β π
β¦Objβ¦" for b
by
(
rule cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf[
OF aYa Hom_aYa that
]
)
show ?thesis
proof(intro is_iso_ntcfI)
from category_axioms assms show
"af_Yoneda_arrow Ξ± π π π : π β¦β©Cβ©F π : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix b assume prems: "b ββ©β π
β¦Objβ¦"
then have πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦" and πb: "πβ¦ObjMapβ¦β¦bβ¦ ββ©β ββ¦Objβ¦"
by (auto intro: cat_cs_intros)
from assms(1,2) aYa prems have aYa_b:
"?aYaβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦βββ πβ¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
show "af_Yoneda_arrow Ξ± π π πβ¦NTMapβ¦β¦bβ¦ : πβ¦ObjMapβ¦β¦bβ¦ β¦β©iβ©sβ©oβββ πβ¦ObjMapβ¦β¦bβ¦"
by
(
rule cat_is_arr_isomorphism_if_ntcf_Hom_snd_is_iso_ntcf[
OF aYa_b Hb[OF prems]
]
)
qed
qed
lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π :
Homβ©Oβ©.β©CβΞ±ββ(π-,-) β¦β©Cβ©Fβ©.β©iβ©sβ©o Homβ©Oβ©.β©CβΞ±ββ(π-,-) :
op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
and "Ξ² = Ξ±"
and "π' = π"
and "π' = π"
shows "af_Yoneda_arrow Ξ± π π π : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π
β¦β¦β©CβΞ±β β"
using assms(1-3)
unfolding assms(4-6)
by (rule cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf)
lemmas [cat_cs_intros] =
category.cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf'
lemma (in category) cat_iso_functor_if_cf_lcomp_Hom_iso_functor:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "Homβ©Oβ©.β©CβΞ±ββ(π-,-) ββ©Cβ©FβΞ±β Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
shows "π ββ©Cβ©FβΞ±β π"
proof-
let ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?aYa = βΉΞ»π. af_Yoneda_arrow Ξ± π π πβΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
from assms(3) obtain π π π where π: "π : ?Hπ β¦β©Cβ©Fβ©.β©iβ©sβ©o ?Hπ : π β¦β¦β©CβΞ±β π"
by auto
interpret π: is_iso_ntcf Ξ± π π ?Hπ ?Hπ π by (rule π)
from category_axioms assms have "?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have π_def: "π = op_cat π
Γβ©C β" and π_def: "π = cat_Set Ξ±"
by (force simp: cat_cs_simps)+
note π = π[unfolded π_def π_def]
from π have "π : ?Hπ β¦β©Cβ©F ?Hπ : op_cat π
Γβ©C β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros)
from category_axioms assms π have
"af_Yoneda_arrow Ξ± π π π : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
β¦β¦β©CβΞ±β β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have "π ββ©Cβ©FβΞ±β π" by (clarsimp intro!: iso_functorI)
then show ?thesis by (rule iso_functor_sym)
qed
lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor:
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π ββ©Cβ©FβΞ±β π"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-) ββ©Cβ©FβΞ±β Homβ©Oβ©.β©CβΞ±ββ(π-,-)"
proof-
let ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?Hπ = βΉHomβ©Oβ©.β©CβΞ±ββ(π-,-)βΊ
and ?aYa = βΉΞ»π. af_Yoneda_arrow Ξ± π π πβΊ
interpret π: is_functor Ξ± π
β π by (rule assms(1))
interpret π: is_functor Ξ± π
β π by (rule assms(2))
from assms obtain π
' β' Ο where Ο: "Ο : π β¦β©Cβ©Fβ©.β©iβ©sβ©o π : π
' β¦β¦β©CβΞ±β β'"
by auto
interpret Ο: is_iso_ntcf Ξ± π
' β' π π Ο by (rule Ο)
from assms Ο.NTDom.is_functor_axioms
have π
'_def: "π
' = π
" and β'_def: "β' = β"
by fast+
note Ο = Ο[unfolded π
'_def β'_def]
show ?thesis
by (rule iso_functor_sym)
(
intro iso_functorI[
OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF Ο]
]
)
qed
lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
assumes "π : π
β¦β¦β©CβΞ±β β"
and "π : π
β¦β¦β©CβΞ±β β"
and "π ββ©Cβ©FβΞ±β π"
and "Ξ±' = Ξ±"
and "β' = β"
shows "Homβ©Oβ©.β©CβΞ±ββ(π-,-) ββ©Cβ©FβΞ±β Homβ©Oβ©.β©CβΞ±'ββ'(π-,-)"
using assms(1-3)
unfolding assms(4,5)
by (rule cat_cf_lcomp_Hom_iso_functor_if_iso_functor)
lemmas [cat_cs_intros] =
category.cat_cf_lcomp_Hom_iso_functor_if_iso_functor'
subsectionβΉThe Yoneda FunctorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉSee Chapter III-2 in \cite{mac_lane_categories_2010}.βΊ
definition Yoneda_functor :: "V β V β V"
where "Yoneda_functor Ξ± π =
[
(Ξ»rββ©βop_cat πβ¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±βπ(r,-))),
(Ξ»fββ©βop_cat πβ¦Arrβ¦. ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπ(f,-))),
op_cat π,
cat_FUNCT Ξ± π (cat_Set Ξ±)
]β©β"
textβΉComponents.βΊ
lemma Yoneda_functor_components:
shows "Yoneda_functor Ξ± πβ¦ObjMapβ¦ =
(Ξ»rββ©βop_cat πβ¦Objβ¦. cf_map (Homβ©Oβ©.β©CβΞ±βπ(r,-)))"
and "Yoneda_functor Ξ± πβ¦ArrMapβ¦ =
(Ξ»fββ©βop_cat πβ¦Arrβ¦. ntcf_arrow (Homβ©Aβ©.β©CβΞ±βπ(f,-)))"
and "Yoneda_functor Ξ± πβ¦HomDomβ¦ = op_cat π"
and "Yoneda_functor Ξ± πβ¦HomCodβ¦ = cat_FUNCT Ξ± π (cat_Set Ξ±)"
unfolding Yoneda_functor_def dghm_field_simps
by (simp_all add: nat_omega_simps)
subsubsectionβΉObject mapβΊ
mk_VLambda Yoneda_functor_components(1)
|vsv Yoneda_functor_ObjMap_vsv[cat_cs_intros]|
|vdomain Yoneda_functor_ObjMap_vdomain[cat_cs_simps]|
|app Yoneda_functor_ObjMap_app[cat_cs_simps]|
lemma (in category) Yoneda_functor_ObjMap_vrange:
"ββ©β (Yoneda_functor Ξ± ββ¦ObjMapβ¦) ββ©β cat_FUNCT Ξ± β (cat_Set Ξ±)β¦Objβ¦"
proof
(
unfold Yoneda_functor_components,
rule vrange_VLambda_vsubset,
unfold cat_op_simps
)
fix c assume "c ββ©β ββ¦Objβ¦"
with category_axioms show
"cf_map Homβ©Oβ©.β©CβΞ±ββ(c,-) ββ©β cat_FUNCT Ξ± β (cat_Set Ξ±)β¦Objβ¦"
unfolding cat_op_simps cat_FUNCT_components
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
subsubsectionβΉArrow mapβΊ
mk_VLambda Yoneda_functor_components(2)
|vsv Yoneda_functor_ArrMap_vsv[cat_cs_intros]|
|vdomain Yoneda_functor_ArrMap_vdomain[cat_cs_simps]|
|app Yoneda_functor_ArrMap_app[cat_cs_simps]|
lemma (in category) Yoneda_functor_ArrMap_vrange:
"ββ©β (Yoneda_functor Ξ± ββ¦ArrMapβ¦) ββ©β cat_FUNCT Ξ± β (cat_Set Ξ±)β¦Arrβ¦"
proof
(
unfold Yoneda_functor_components,
rule vrange_VLambda_vsubset,
unfold cat_op_simps
)
fix f assume "f ββ©β ββ¦Arrβ¦"
then obtain a b where f: "f : a β¦βββ b" by auto
define Ξ² where "Ξ² = Ξ± + Ο"
have π΅Ξ²: "π΅ Ξ²" and Ξ±Ξ²: "Ξ± ββ©β Ξ²"
by (simp_all add: π΅_Ξ±_Ξ±Ο π΅.intro π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο Ξ²_def)
from tiny_category_cat_FUNCT category_axioms π΅Ξ² Ξ±Ξ² f show
"ntcf_arrow Homβ©Aβ©.β©CβΞ±ββ(f,-) ββ©β cat_FUNCT Ξ± β (cat_Set Ξ±)β¦Arrβ¦"
unfolding cat_op_simps
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed
subsubsectionβΉThe Yoneda Functor is a fully faithful functorβΊ
lemma (in category) cat_Yoneda_functor_is_functor:
assumes "π΅ Ξ²" and "Ξ± ββ©β Ξ²"
shows "Yoneda_functor Ξ± β : op_cat β β¦β¦β©Cβ©.β©fβ©fβΞ²β cat_FUNCT Ξ± β (cat_Set Ξ±)"
proof
(
intro
is_ff_functorI
is_ft_functorI'
is_fl_functorI'
vsubset_antisym
vsubsetI,
unfold cat_op_simps in_Hom_iff,
tacticβΉdistinct_subgoals_tacβΊ
)
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (rule category_cat_Set)
let ?Yf = βΉYoneda_functor Ξ± ββΊ and ?FUNCT = βΉcat_FUNCT Ξ± β (cat_Set Ξ±)βΊ
show Yf: "?Yf : op_cat β β¦β¦β©CβΞ²β ?FUNCT"
proof(intro is_functorI')
show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
from assms have "category Ξ² β" by (intro cat_category_if_ge_Limit)
then show "category Ξ² (op_cat β)" by (intro category.category_op)
from assms show "category Ξ² ?FUNCT"
by (cs_concl cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT)
show "vcard ?Yf = 4β©β"
unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
show "ββ©β (?Yfβ¦ObjMapβ¦) ββ©β ?FUNCTβ¦Objβ¦"
by (rule Yoneda_functor_ObjMap_vrange)
show "?Yfβ¦ArrMapβ¦β¦fβ¦ : ?Yfβ¦ObjMapβ¦β¦aβ¦ β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β ?Yfβ¦ObjMapβ¦β¦bβ¦"
if "f : a β¦βop_cat ββ b" for a b f
using that category_axioms
unfolding cat_op_simps
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
show "?Yfβ¦ArrMapβ¦β¦g ββ©Aβop_cat ββ fβ¦ =
?Yfβ¦ArrMapβ¦β¦gβ¦ ββ©Aβ?FUNCTβ ?Yfβ¦ArrMapβ¦β¦fβ¦"
if "g : b β¦βop_cat ββ c" and "f : a β¦βop_cat ββ b" for b c g a f
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show "?Yfβ¦ArrMapβ¦β¦op_cat ββ¦CIdβ¦β¦cβ¦β¦ = ?FUNCTβ¦CIdβ¦β¦?Yfβ¦ObjMapβ¦β¦cβ¦β¦"
if "c ββ©β op_cat ββ¦Objβ¦" for c
using that category_axioms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (auto simp: assms(1) Yoneda_functor_components π΅.intro π΅_Limit_Ξ±Ο π΅_Ο_Ξ±Ο)
interpret Yf: is_functor Ξ² βΉop_cat ββΊ βΉ?FUNCTβΊ βΉ?YfβΊ by (rule Yf)
show "v11 (?Yfβ¦ArrMapβ¦ βΎβ§lβ©β Hom β b a)"
if "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦" for a b
proof-
from that have dom_Y_ba: "πβ©β (?Yfβ¦ArrMapβ¦ βΎβ§lβ©β Hom β b a) = Hom β b a"
by
(
fastforce simp:
cat_op_simps
in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
)
show "v11 (?Yfβ¦ArrMapβ¦ βΎβ§lβ©β Hom β b a)"
proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
fix g f assume prems:
"g : b β¦βββ a"
"f : b β¦βββ a"
"(?Yfβ¦ArrMapβ¦ βΎβ§lβ©β Hom β b a)β¦gβ¦ = (?Yfβ¦ArrMapβ¦ βΎβ§lβ©β Hom β b a)β¦fβ¦"
from
prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of Ξ± β]
have "Homβ©Aβ©.β©CβΞ±ββ(g,-) = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
by
(
cs_prems
cs_simp: V_cs_simps cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros
)
from this prems(1,2) show "g = f" by (rule cat_ntcf_Hom_snd_inj)
qed (auto simp: Yoneda_functor_components)
qed
fix a b assume prems: "a ββ©β ββ¦Objβ¦" "b ββ©β ββ¦Objβ¦"
show "π : ?Yfβ¦ObjMapβ¦β¦aβ¦ β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β ?Yfβ¦ObjMapβ¦β¦bβ¦"
if "π ββ©β ?Yfβ¦ArrMapβ¦ `β©β Hom β b a" for π
proof-
from that obtain f where "?Yfβ¦ArrMapβ¦β¦fβ¦ = π" and f: "f : b β¦βββ a"
by (force elim!: Yf.ArrMap.vsv_vimageE)
then have π_def: "π = ntcf_arrow Homβ©Aβ©.β©CβΞ±ββ(f,-)"
unfolding
Yoneda_functor_ArrMap_app[
unfolded cat_op_simps, OF cat_is_arrD(1)[OF f]
]
by (simp add: cat_cs_simps cat_op_simps cat_cs_intros)
from category_axioms f show ?thesis
unfolding π_def
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
)
qed
show "π ββ©β ?Yfβ¦ArrMapβ¦ `β©β Hom β b a"
if "π : ?Yfβ¦ObjMapβ¦β¦aβ¦ β¦βcat_FUNCT Ξ± β (cat_Set Ξ±)β ?Yfβ¦ObjMapβ¦β¦bβ¦" for π
proof-
note π = cat_FUNCT_is_arrD[OF that]
from π(1) category_axioms prems have ntcf_π:
"ntcf_of_ntcf_arrow β (cat_Set Ξ±) π :
Homβ©Oβ©.β©CβΞ±ββ(a,-) β¦β©Cβ©F Homβ©Oβ©.β©CβΞ±ββ(b,-) : β β¦β¦β©CβΞ±β cat_Set Ξ±"
by (subst (asm) π(3), use nothing in βΉsubst (asm) π(4)βΊ)
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
)
from cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF prems ntcf_π] obtain f
where f: "f : b β¦βββ a"
and π_def: "ntcf_of_ntcf_arrow β (cat_Set Ξ±) π = Homβ©Aβ©.β©CβΞ±ββ(f,-)"
by auto
from π(2) f show "π ββ©β Yoneda_functor Ξ± ββ¦ArrMapβ¦ `β©β Hom β b a"
unfolding π_def
by (intro Yf.ArrMap.vsv_vimage_eqI[of f])
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)+
qed
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Order
sectionβΉOrdersβΊ
theory CZH_ECAT_Order
imports
CZH_ECAT_Functor
begin
subsectionβΉBackgroundβΊ
named_theorems cat_order_cs_simps
named_theorems cat_order_cs_intros
subsectionβΉPreorder categoryβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
locale cat_preorder = category Ξ± β for Ξ± β +
assumes cat_peo:
"β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦ β§ βΉ
(βf. Hom β a b = set {f}) β¨ (Hom β a b = 0)"
textβΉRules.βΊ
lemma (in cat_preorder) cat_preorder_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_preorder Ξ±' β"
unfolding assms by (rule cat_preorder_axioms)
mk_ide rf cat_preorder_def[unfolded cat_preorder_axioms_def]
|intro cat_preorderI|
|dest cat_preorderD[dest]|
|elim cat_preorderE[elim]|
lemmas [cat_order_cs_intros] = cat_preorderD(1)
textβΉElementary properties.βΊ
lemma (in cat_preorder) cat_peo_HomE:
assumes "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
obtains f where βΉHom β a b = set {f}βΊ | βΉHom β a b = 0βΊ
using cat_peo[OF assms] by auto
lemma (in cat_preorder) cat_peo_is_thin_category:
assumes "f : a β¦βββ b" and "g : a β¦βββ b"
shows "f = g"
proof-
note f = cat_is_arrD[OF assms(1)]
from assms have "Hom β a b β 0" by (metis HomI eq0_iff)
with cat_peo_HomE[OF f(2,3)] obtain h where "Hom β a b = set {h}" by auto
moreover from assms have "f ββ©β Hom β a b" and "g ββ©β Hom β a b" by auto
ultimately have "h = f" and "h = g" by auto
then show ?thesis by auto
qed
subsectionβΉOrder relationβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition is_le :: "V β V β V β bool" (infix βΉβ€β©OΔ±βΊ 50)
where "a β€β©Oβββ b β· Hom β a b β 0"
textβΉRules.βΊ
mk_ide is_le_def
|intro is_leI|
|dest is_leD[dest]|
|elim is_leE[elim]|
textβΉElementary properties.βΊ
lemma (in cat_preorder) cat_peo_is_le[cat_order_cs_intros]:
assumes "f : a β¦βββ b"
shows "a β€β©Oβββ b"
using assms by (force intro: is_leI)
lemmas [cat_order_cs_intros] = cat_preorder.cat_peo_is_le
lemma (in cat_preorder) cat_peo_is_le_ex1:
assumes "a β€β©Oβββ b" and "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
shows "β!f. f : a β¦βββ b"
proof-
from assms have "Hom β a b β 0" by auto
with assms cat_peo obtain f where Hom_ab: "Hom β a b = set {f}" by meson
show "β!f. f : a β¦βββ b"
proof(intro ex1I)
from Hom_ab show "f : a β¦βββ b" by auto
fix g assume "g : a β¦βββ b"
with Hom_ab show "g = f" by auto
qed
qed
lemma (in cat_preorder) cat_peo_is_le_ex[elim]:
assumes "a β€β©Oβββ b" and "a ββ©β ββ¦Objβ¦" and "b ββ©β ββ¦Objβ¦"
obtains f where "f : a β¦βββ b"
using cat_peo_is_le_ex1[OF assms] that by clarsimp
subsubsectionβΉOrder relation on a preorder category is a preorderβΊ
lemma (in cat_preorder) is_le_refl:
assumes "a ββ©β ββ¦Objβ¦"
shows "a β€β©Oβββ a"
proof(intro is_leI)
from assms have "ββ¦CIdβ¦β¦aβ¦ ββ©β Hom β a a" by (cs_concl cs_intro: cat_cs_intros)
then show "Hom β a a β 0" by force
qed
lemma (in cat_preorder) is_le_trans:
assumes "a ββ©β ββ¦Objβ¦"
and "b ββ©β ββ¦Objβ¦"
and "c ββ©β ββ¦Objβ¦"
and "a β€β©Oβββ b"
and "b β€β©Oβββ c"
shows "a β€β©Oβββ c"
proof(intro is_leI)
from assms obtain f where f: "f : a β¦βββ b" by auto
from assms obtain g where g: "g : b β¦βββ c" by auto
from f g have "g ββ©Aβββ f : a β¦βββ c"
by (cs_concl cs_intro: cat_cs_intros)
then show "Hom β a c β 0" by force
qed
subsectionβΉPartial order categoryβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
locale cat_partial_order = cat_preorder Ξ± β for Ξ± β +
assumes cat_po: "β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦; a β€β©Oβββ b; b β€β©Oβββ a β§ βΉ a = b"
textβΉRules.βΊ
lemma (in cat_partial_order) cat_partial_order_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_partial_order Ξ±' β"
unfolding assms by (rule cat_partial_order_axioms)
mk_ide rf cat_partial_order_def[unfolded cat_partial_order_axioms_def]
|intro cat_partial_orderI|
|dest cat_partial_orderD[dest]|
|elim cat_partial_orderE[elim]|
lemmas [cat_order_cs_intros] = cat_partial_orderD(1)
subsectionβΉLinear order categoryβΊ
textβΉSee Chapter I-2 in \cite{mac_lane_categories_2010}.βΊ
locale cat_linear_order = cat_partial_order Ξ± β for Ξ± β +
assumes cat_lo: "β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦ β§ βΉ a β€β©Oβββ b β¨ b β€β©Oβββ a"
textβΉRules.βΊ
lemma (in cat_linear_order) cat_linear_order_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_linear_order Ξ±' β"
unfolding assms by (rule cat_linear_order_axioms)
mk_ide rf cat_linear_order_def[unfolded cat_linear_order_axioms_def]
|intro cat_linear_orderI|
|dest cat_linear_orderD[dest]|
|elim cat_linear_orderE[elim]|
lemmas [cat_order_cs_intros] = cat_linear_orderD(1)
subsectionβΉPreorder functorβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
See \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/monotone+function}
}.
βΊ
locale is_preorder_functor =
is_functor Ξ± π π
π + HomDom: cat_preorder Ξ± π + HomCod: cat_preorder Ξ± π
for Ξ± π π
π
syntax "_is_preorder_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β€β©Cβ©.β©Pβ©Eβ©OΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β€β©Cβ©.β©Pβ©Eβ©OβΞ±β π
" β "CONST is_preorder_functor Ξ± π π
π"
textβΉRules.βΊ
lemma (in is_preorder_functor) is_preorder_functor_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β€β©Cβ©.β©Pβ©Eβ©OβΞ±'β π
'"
unfolding assms by (rule is_preorder_functor_axioms)
mk_ide rf is_preorder_functor_def
|intro is_preorder_functorI|
|dest is_preorder_functorD[dest]|
|elim is_preorder_functorE[elim]|
lemmas [cat_order_cs_intros] = is_preorder_functorD
subsubsectionβΉA preorder functor is a faithful functorβΊ
sublocale is_preorder_functor β is_ft_functor
proof(intro is_ft_functorI')
fix a b assume "a ββ©β πβ¦Objβ¦" "b ββ©β πβ¦Objβ¦"
show "v11 (πβ¦ArrMapβ¦ βΎβ§lβ©β Hom π a b)"
proof
(
intro vsv.vsv_valeq_v11I,
unfold vdomain_vlrestriction cat_cs_simps vintersection_iff;
(elim conjE)?
)
fix g f assume "g : a β¦βπβ b" "f : a β¦βπβ b"
then show "g = f" by (auto simp: HomDom.cat_peo_is_thin_category)
qed simp
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemmas (in is_preorder_functor) is_preorder_functor_is_ft_functor =
is_ft_functor_axioms
lemmas [cat_order_cs_intros] =
is_preorder_functor.is_preorder_functor_is_ft_functor
subsubsectionβΉA preorder functor is a monotone functionβΊ
lemma (in is_preorder_functor) cat_peo:
assumes "a ββ©β πβ¦Objβ¦" and "b ββ©β πβ¦Objβ¦" and "a β€β©Oβπβ b"
shows "πβ¦ObjMapβ¦β¦aβ¦ β€β©Oβπ
β πβ¦ObjMapβ¦β¦bβ¦"
proof-
from assms obtain f where "f : a β¦βπβ b" by auto
then have "πβ¦ArrMapβ¦β¦fβ¦ : πβ¦ObjMapβ¦β¦aβ¦ β¦βπ
β πβ¦ObjMapβ¦β¦bβ¦"
by (simp add: cf_ArrMap_is_arr)
then show "πβ¦ObjMapβ¦β¦aβ¦ β€β©Oβπ
β πβ¦ObjMapβ¦β¦bβ¦"
by (cs_concl cs_intro: cat_order_cs_intros)
qed
subsubsectionβΉComposition of preorder functorsβΊ
lemma cf_comp_is_preorder_functor[cat_order_cs_intros]:
assumes "π : π
β€β©Cβ©.β©Pβ©Eβ©OβΞ±β β" and "π : π β€β©Cβ©.β©Pβ©Eβ©OβΞ±β π
"
shows "π ββ©Cβ©F π : π β€β©Cβ©.β©Pβ©Eβ©OβΞ±β β"
proof-
interpret π: is_preorder_functor Ξ± π
β π by (rule assms(1))
interpret π: is_preorder_functor Ξ± π π
π by (rule assms(2))
show ?thesis
by (intro is_preorder_functorI)
(cs_concl cs_intro: cat_cs_intros cat_order_cs_intros)+
qed
lemma (in cat_preorder) cat_peo_cf_is_preorder_functor:
"cf_id β : β β€β©Cβ©.β©Pβ©Eβ©OβΞ±β β"
by (intro is_preorder_functorI)
(cs_concl cs_intro: cat_cs_intros cat_order_cs_intros)+
lemma (in cat_preorder) cat_peo_cf_is_preorder_functor'[cat_order_cs_intros]:
assumes "π' = β" and "π
' = β"
shows "cf_id β : π' β€β©Cβ©.β©Pβ©Eβ©OβΞ±β π
'"
unfolding assms by (rule cat_peo_cf_is_preorder_functor)
lemmas [cat_order_cs_intros] = cat_preorder.cat_peo_cf_is_preorder_functor'
end
Theory CZH_ECAT_Small_Order
sectionβΉSmallness for ordersβΊ
theory CZH_ECAT_Small_Order
imports
CZH_ECAT_Order
CZH_ECAT_Small_Functor
begin
subsectionβΉBackgroundβΊ
named_theorems cat_small_order_cs_simps
named_theorems cat_small_order_cs_intros
subsectionβΉTiny preorder categoryβΊ
locale cat_tiny_preorder = tiny_category Ξ± β for Ξ± β +
assumes cat_tiny_peo:
"β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦ β§ βΉ
(βf. Hom β a b = set {f}) β¨ (Hom β a b = 0)"
textβΉRules.βΊ
lemma (in cat_tiny_preorder) cat_tiny_preorder_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_tiny_preorder Ξ±' β"
unfolding assms by (rule cat_tiny_preorder_axioms)
mk_ide rf cat_tiny_preorder_def[unfolded cat_tiny_preorder_axioms_def]
|intro cat_tiny_preorderI|
|dest cat_tiny_preorderD[dest]|
|elim cat_tiny_preorderE[elim]|
lemmas [cat_small_order_cs_intros] = cat_tiny_preorderD(1)
textβΉTiny preorder is a preorder.βΊ
sublocale cat_tiny_preorder β cat_preorder
by (intro cat_preorderI cat_tiny_peo category_axioms) simp_all
lemmas (in cat_tiny_preorder) cat_tiny_peo_is_cat_preoder = cat_preorder_axioms
lemmas [cat_small_order_cs_intros] =
cat_tiny_preorder.cat_tiny_peo_is_cat_preoder
subsectionβΉTiny partial order categoryβΊ
locale cat_tiny_partial_order = cat_tiny_preorder Ξ± β for Ξ± β +
assumes cat_tiny_po:
"β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦; a β€β©Oβββ b; b β€β©Oβββ a β§ βΉ a = b"
textβΉRules.βΊ
lemma (in cat_tiny_partial_order)
cat_tiny_partial_order_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_tiny_partial_order Ξ±' β"
unfolding assms by (rule cat_tiny_partial_order_axioms)
mk_ide rf cat_tiny_partial_order_def[unfolded cat_tiny_partial_order_axioms_def]
|intro cat_tiny_partial_orderI|
|dest cat_tiny_partial_orderD[dest]|
|elim cat_tiny_partial_orderE[elim]|
lemmas [cat_small_order_cs_intros] = cat_tiny_partial_orderD(1)
textβΉTiny partial order is a partial order.βΊ
sublocale cat_tiny_partial_order β cat_partial_order
by (intro cat_partial_orderI cat_tiny_po cat_preorder_axioms) simp_all
lemmas (in cat_tiny_preorder) cat_tiny_po_is_cat_preoder = cat_preorder_axioms
lemmas [cat_small_order_cs_intros] =
cat_tiny_preorder.cat_tiny_peo_is_cat_preoder
lemma cat_tiny_partial_orderI':
assumes "tiny_category Ξ± β"
and "cat_partial_order Ξ± β"
shows "cat_tiny_partial_order Ξ± β"
proof-
interpret tiny_category Ξ± β by (rule assms(1))
interpret cat_partial_order Ξ± β by (rule assms(2))
show ?thesis
by (intro cat_tiny_partial_orderI cat_tiny_preorderI assms(1) cat_po cat_peo)
qed
subsectionβΉTiny linear order categoryβΊ
locale cat_tiny_linear_order = cat_tiny_partial_order Ξ± β for Ξ± β +
assumes cat_tiny_lo: "β¦ a ββ©β ββ¦Objβ¦; b ββ©β ββ¦Objβ¦ β§ βΉ a β€β©Oβββ b β¨ b β€β©Oβββ a"
textβΉRules.βΊ
lemma (in cat_tiny_linear_order)
cat_tiny_linear_order_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "cat_tiny_linear_order Ξ±' β"
unfolding assms by (rule cat_tiny_linear_order_axioms)
mk_ide rf cat_tiny_linear_order_def[unfolded cat_tiny_linear_order_axioms_def]
|intro cat_tiny_linear_orderI|
|dest cat_tiny_linear_orderD[dest]|
|elim cat_tiny_linear_orderE[elim]|
lemmas [cat_small_order_cs_intros] = cat_tiny_linear_orderD(1)
textβΉTiny linear order is a partial order.βΊ
sublocale cat_tiny_linear_order β cat_linear_order
by (intro cat_linear_orderI cat_tiny_lo cat_partial_order_axioms) simp_all
lemmas (in cat_tiny_linear_order) cat_tiny_lo_is_cat_partial_order =
cat_linear_order_axioms
lemmas [cat_small_order_cs_intros] =
cat_tiny_linear_order.cat_tiny_lo_is_cat_partial_order
lemma cat_tiny_linear_orderI':
assumes "tiny_category Ξ± β" and "cat_linear_order Ξ± β"
shows "cat_tiny_linear_order Ξ± β"
proof-
interpret tiny_category Ξ± β by (rule assms(1))
interpret cat_linear_order Ξ± β by (rule assms(2))
show ?thesis
by
(
intro
assms(1)
cat_tiny_linear_orderI
cat_tiny_partial_orderI'
cat_partial_order_axioms
cat_lo
)
qed
subsectionβΉTiny preorder functorβΊ
locale is_tiny_preorder_functor =
is_functor Ξ± π π
π +
HomDom: cat_tiny_preorder Ξ± π +
HomCod: cat_tiny_preorder Ξ± π
for Ξ± π π
π
syntax "_is_tiny_preorder_functor" :: "V β V β V β V β bool"
(βΉ(_ :/ _ β€β©Cβ©.β©Pβ©Eβ©Oβ©.β©tβ©iβ©nβ©yΔ± _)βΊ [51, 51, 51] 51)
translations "π : π β€β©Cβ©.β©Pβ©Eβ©Oβ©.β©tβ©iβ©nβ©yβΞ±β π
" β
"CONST is_tiny_preorder_functor Ξ± π π
π"
textβΉRules.βΊ
lemma (in is_tiny_preorder_functor)
is_tiny_preorder_functor_axioms'[cat_order_cs_intros]:
assumes "Ξ±' = Ξ±" and "π' = π" and "π
' = π
"
shows "π : π' β€β©Cβ©.β©Pβ©Eβ©Oβ©.β©tβ©iβ©nβ©yβΞ±'β π
'"
unfolding assms by (rule is_tiny_preorder_functor_axioms)
mk_ide rf is_tiny_preorder_functor_def
|intro is_tiny_preorder_functorI|
|dest is_tiny_preorder_functorD[dest]|
|elim is_tiny_preorder_functorE[elim]|
lemmas [cat_small_order_cs_intros] = is_tiny_preorder_functorD(1)
textβΉTiny preorder functor is a tiny functorβΊ
sublocale is_tiny_preorder_functor β is_tiny_functor
by
(
intro
is_tiny_functorI'
is_functor_axioms
HomDom.tiny_category_axioms
HomCod.tiny_category_axioms
)
end
Theory CZH_ECAT_Ordinal
sectionβΉOrdinal numbersβΊ
theory CZH_ECAT_Ordinal
imports CZH_ECAT_Small_Order
begin
subsectionβΉBackgroundβΊ
textβΉ
The content of this section is based on the treatment of the ordinal numbers
from the perspective of category theory as exposed, for example,
in Chapter I-2 in \cite{mac_lane_categories_2010}.
βΊ
named_theorems cat_ordinal_cs_simps
named_theorems cat_ordinal_cs_intros
subsectionβΉArrows associated with an ordinal numberβΊ
definition ordinal_arrs :: "V β V"
where "ordinal_arrs A β‘ set {[a, b]β©β | a b. a ββ©β A β§ b ββ©β A β§ a β€ b}"
lemma small_ordinal_arrs[simp]:
"small {[a, b]β©β | a b. a ββ©β A β§ b ββ©β A β§ a β€ b}"
by (rule down[where x=βΉA Γβ©β AβΊ]) auto
textβΉRules.βΊ
lemma ordinal_arrsI[cat_ordinal_cs_intros]:
assumes "x = [a, b]β©β" and "a ββ©β A" and "b ββ©β A" and "a β€ b"
shows "x ββ©β ordinal_arrs A"
using assms unfolding ordinal_arrs_def by auto
lemma ordinal_arrsD[dest]:
assumes "[a, b]β©β ββ©β ordinal_arrs A"
shows "a ββ©β A" and "b ββ©β A" and "a β€ b"
using assms unfolding ordinal_arrs_def by auto
lemma ordinal_arrsE[elim]:
assumes "x ββ©β ordinal_arrs A"
obtains a b where "a ββ©β A" and "b ββ©β A" and "a β€ b" and "x = [a, b]β©β"
using assms unfolding ordinal_arrs_def by clarsimp
subsectionβΉComposable arrowsβΊ
abbreviation ordinal_composable :: "V β V"
where "ordinal_composable A β‘ set
{
[[b, c]β©β, [a, b]β©β]β©β | a b c.
a ββ©β A β§ b ββ©β A β§ c ββ©β A β§ a β€ b β§ b β€ c
}"
lemma small_ordinal_composable[simp]:
"small
{
[[b, c]β©β, [a, b]β©β]β©β | a b c.
a ββ©β A β§ b ββ©β A β§ c ββ©β A β§ a β€ b β§ b β€ c
}"
by (rule down[where x=βΉ(A Γβ©β A) Γβ©β (A Γβ©β A)βΊ]) auto
textβΉRules.βΊ
lemma ordinal_composableI[cat_ordinal_cs_intros]:
assumes "x = [[b, c]β©β, [a, b]β©β]β©β"
and "a ββ©β A"
and "b ββ©β A"
and "c ββ©β A"
and "a β€ b"
and "b β€ c"
shows "x ββ©β ordinal_composable A"
using assms by auto
lemma ordinal_composableD[dest]:
assumes "[[b, c]β©β, [a, b]β©β]β©β ββ©β ordinal_composable A"
shows "a ββ©β A" and "b ββ©β A" and "c ββ©β A" and "a β€ b" and "b β€ c"
using assms by auto
lemma ordinal_composableE[elim]:
assumes "x ββ©β ordinal_composable A"
obtains a b c
where "x = [[b, c]β©β, [a, b]β©β]β©β"
and "a ββ©β A"
and "b ββ©β A"
and "c ββ©β A"
and "a β€ b"
and "b β€ c"
using assms by clarsimp
subsectionβΉOrdinal number as a categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_ordinal :: "V β V"
where "cat_ordinal A =
[
A,
ordinal_arrs A,
(Ξ»fββ©βordinal_arrs A. fβ¦0β¦),
(Ξ»fββ©βordinal_arrs A. fβ¦1β©ββ¦),
(Ξ»gfββ©βordinal_composable A. [gfβ¦1β©ββ¦β¦0β¦, gfβ¦0β¦β¦1β©ββ¦]β©β),
(Ξ»xββ©βA. [x, x]β©β)
]β©β"
textβΉComponents.βΊ
lemma cat_ordinal_components:
shows [cat_ordinal_cs_simps]: "cat_ordinal Aβ¦Objβ¦ = A"
and [cat_ordinal_cs_simps]: "cat_ordinal Aβ¦Arrβ¦ = ordinal_arrs A"
and "cat_ordinal Aβ¦Domβ¦ = (Ξ»fββ©βordinal_arrs A. fβ¦0β¦)"
and "cat_ordinal Aβ¦Codβ¦ = (Ξ»fββ©βordinal_arrs A. fβ¦1β©ββ¦)"
and "cat_ordinal Aβ¦Compβ¦ =
(Ξ»gfββ©βordinal_composable A. [gfβ¦1β©ββ¦β¦0β¦, gfβ¦0β¦β¦1β©ββ¦]β©β)"
and "cat_ordinal Aβ¦CIdβ¦ = (Ξ»xββ©βA. [x, x]β©β)"
unfolding cat_ordinal_def dg_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉDomainβΊ
mk_VLambda cat_ordinal_components(3)
|vsv cat_ordinal_Dom_vsv[cat_ordinal_cs_intros]|
|vdomain
cat_ordinal_Dom_vdomain[
folded cat_ordinal_components, cat_ordinal_cs_simps
]
|
lemma cat_ordinal_Dom_app[cat_ordinal_cs_simps]:
assumes "x ββ©β cat_ordinal Aβ¦Arrβ¦" and "x = [a, b]β©β"
shows "cat_ordinal Aβ¦Domβ¦β¦xβ¦ = a"
using assms(1) unfolding assms(2) cat_ordinal_components by auto
lemma cat_ordinal_Dom_vrange: "ββ©β (cat_ordinal Aβ¦Domβ¦) ββ©β cat_ordinal Aβ¦Objβ¦"
unfolding cat_ordinal_components
by (intro vrange_VLambda_vsubset, elim ordinal_arrsE) simp
subsubsectionβΉCodomainβΊ
mk_VLambda cat_ordinal_components(4)
|vsv cat_ordinal_Cod_vsv[cat_ordinal_cs_intros]|
|vdomain
cat_ordinal_Cod_vdomain[
folded cat_ordinal_components, cat_ordinal_cs_simps
]
|
lemma cat_ordinal_Cod_app[cat_ordinal_cs_simps]:
assumes "x ββ©β cat_ordinal Aβ¦Arrβ¦" and "x = [a, b]β©β"
shows "cat_ordinal Aβ¦Codβ¦β¦xβ¦ = b"
using assms(1)
unfolding assms(2) cat_ordinal_components
by (auto simp: nat_omega_simps)
lemma cat_ordinal_Cod_vrange: "ββ©β (cat_ordinal Aβ¦Codβ¦) ββ©β cat_ordinal Aβ¦Objβ¦"
unfolding cat_ordinal_components
by (intro vrange_VLambda_vsubset, elim ordinal_arrsE)
(simp add: nat_omega_simps)
subsubsectionβΉArrow with a domain and a codomainβΊ
textβΉRules.βΊ
lemma cat_ordinal_is_arrI[cat_ordinal_cs_intros]:
assumes "a ββ©β A" and "b ββ©β A" and "a β€ b" and "f = [a, b]β©β"
shows "f : a β¦βcat_ordinal Aβ b"
proof(intro is_arrI, unfold cat_ordinal_components(2))
from assms show "f ββ©β ordinal_arrs A" by (intro ordinal_arrsI)
then show "cat_ordinal Aβ¦Domβ¦β¦fβ¦ = a" "cat_ordinal Aβ¦Codβ¦β¦fβ¦ = b"
by (cs_concl cs_simp: cat_ordinal_cs_simps assms(4))+
qed
lemma cat_ordinal_is_arrD[dest]:
assumes "f : a β¦βcat_ordinal Aβ b"
shows "a ββ©β A" and "b ββ©β A" and "a β€ b" and "f = [a, b]β©β"
proof-
note f = is_arrD[OF assms, unfolded cat_ordinal_components(2)]
from f(1) obtain a' b'
where a': "a' ββ©β A"
and b': "b' ββ©β A"
and a'b': "a' β€ b'"
and f_def: "f = [a', b']β©β"
unfolding ordinal_arrs_def by clarsimp
from f(2) a' b' a'b' have a'_def: "a' = a"
by
(
cs_prems
cs_simp: cat_ordinal_cs_simps f_def cs_intro: cat_ordinal_cs_intros
)
from f(3) a' b' a'b' have b'_def: "b' = b"
by
(
cs_prems
cs_simp: cat_ordinal_cs_simps f_def cs_intro: cat_ordinal_cs_intros
)
from a' b' a'b' f_def show "a ββ©β A" and "b ββ©β A" and "a β€ b" and "f = [a, b]β©β"
unfolding a'_def b'_def by auto
qed
lemma cat_ordinal_is_arrE[elim]:
assumes "f : a β¦βcat_ordinal Aβ b"
obtains "a ββ©β A" and "b ββ©β A" and "a β€ b" and "f = [a, b]β©β"
using assms by auto
textβΉElementary properties.βΊ
lemma cat_ordinal_is_arr_not:
assumes "Β¬a β€ b"
shows "Β¬f : a β¦βcat_ordinal Aβ b"
proof(rule ccontr, unfold not_not)
assume "f : a β¦βcat_ordinal Aβ b"
with cat_ordinal_is_arrD(3)[OF this] assms show False by simp
qed
lemma cat_ordinal_is_arr_is_unique:
assumes "f : a β¦βcat_ordinal Aβ b" and "g : a β¦βcat_ordinal Aβ b"
shows "f = g"
by
(
simp add:
cat_ordinal_is_arrD(4)[OF assms(1)]
cat_ordinal_is_arrD(4)[OF assms(2)]
)
lemma cat_ordinal_Hom_ne:
assumes "f : a β¦βcat_ordinal Aβ b"
shows "Hom (cat_ordinal A) a b = set {f}"
using assms cat_ordinal_is_arr_is_unique
by (intro vsubset_antisym vsubsetI) auto
lemma cat_ordinal_Hom_empty:
assumes "Β¬a β€ b"
shows "Hom (cat_ordinal A) a b = 0"
using assms by (intro vsubset_antisym vsubsetI) auto
lemma cat_ordinal_inj:
assumes "cat_ordinal m = cat_ordinal n"
shows "m = n"
by (metis assms cat_ordinal_components(1))
subsubsectionβΉCompositionβΊ
mk_VLambda cat_ordinal_components(5)
|vsv cat_ordinal_Comp_vsv[cat_ordinal_cs_intros]|
|vdomain cat_ordinal_Comp_vdomain[folded cat_ordinal_components, cat_cs_simps]|
lemma cat_ordinal_Comp_app[cat_ordinal_cs_simps]:
assumes "g : b β¦βcat_ordinal Aβ c" and "f : a β¦βcat_ordinal Aβ b"
shows "g ββ©Aβcat_ordinal Aβ f = [a, c]β©β"
proof-
from assms(2) have a: "a ββ©β A"
and b: "b ββ©β A"
and ab: "a β€ b"
and f_def: "f = [a, b]β©β"
by auto
from assms(1) have c: "c ββ©β A" and bc: "b β€ c" and g_def: "g = [b, c]β©β"
by auto
from a b c ab bc have "[g, f]β©β ββ©β ordinal_composable A"
by (cs_concl cs_simp: g_def f_def cs_intro: cat_ordinal_cs_intros)
then show "g ββ©Aβcat_ordinal Aβ f = [a, c]β©β"
unfolding cat_ordinal_components by (simp add: g_def f_def nat_omega_simps)
qed
subsubsectionβΉIdentityβΊ
mk_VLambda cat_ordinal_components(6)
|vsv cat_ordinal_CId_vsv[cat_ordinal_cs_intros]|
|vdomain cat_ordinal_CId_vdomain[cat_ordinal_cs_simps]|
|app cat_ordinal_CId_app[cat_ordinal_cs_simps]|
subsubsectionβΉOrder relationβΊ
lemma cat_ordinal_is_leD[dest]:
assumes "a β€β©Oβcat_ordinal Aβ b"
shows "[a, b]β©β : a β¦βcat_ordinal Aβ b"
proof(intro cat_ordinal_is_arrI)
from is_leD[OF assms] obtain f where "f : a β¦βcat_ordinal Aβ b" by fastforce
then show "a ββ©β A" "b ββ©β A" "a ββ©β b" by auto
qed simp
lemma cat_ordinal_is_leE[elim]:
assumes "a β€β©Oβcat_ordinal Aβ b"
obtains "[a, b]β©β : a β¦βcat_ordinal Aβ b"
using assms by auto
lemma cat_ordinal_is_le_iff:
"a β€β©Oβcat_ordinal Aβ b β· [a, b]β©β : a β¦βcat_ordinal Aβ b"
using cat_ordinal_is_leD cat_ordinal_is_leE
by (metis HomI is_le_def vempty_nin)
subsubsectionβΉEvery ordinal number is a categoryβΊ
lemma (in π΅) cat_linear_order_cat_ordinal[cat_ordinal_cs_intros]:
assumes "Ord A" and "A ββ©β Ξ±"
shows "cat_linear_order Ξ± (cat_ordinal A)"
proof(intro cat_linear_orderI cat_partial_orderI cat_preorderI categoryI')
show "vfsequence (cat_ordinal A)" unfolding cat_ordinal_def by auto
show "vcard (cat_ordinal A) = 6β©β"
unfolding cat_ordinal_def by (simp add: nat_omega_simps)
show "ββ©β (cat_ordinal Aβ¦Domβ¦) ββ©β cat_ordinal Aβ¦Objβ¦"
by (rule cat_ordinal_Dom_vrange)
show "ββ©β (cat_ordinal Aβ¦Codβ¦) ββ©β cat_ordinal Aβ¦Objβ¦"
by (rule cat_ordinal_Cod_vrange)
show "(gf ββ©β πβ©β (cat_ordinal Aβ¦Compβ¦)) β·
(
βg f b c a.
gf = [g, f]β©β β§ g : b β¦βcat_ordinal Aβ c β§ f : a β¦βcat_ordinal Aβ b
)"
for gf
unfolding cat_ordinal_Comp_vdomain
proof
assume "gf ββ©β ordinal_composable A"
then obtain a b c
where gf_def: "gf = [[b, c]β©β, [a, b]β©β]β©β"
and a: "a ββ©β A"
and b: "b ββ©β A"
and c: "c ββ©β A"
and ab: "a β€ b"
and bc: "b β€ c"
by clarsimp
from a b c ab bc show
"βg f b c a.
gf = [g, f]β©β β§ g : b β¦βcat_ordinal Aβ c β§ f : a β¦βcat_ordinal Aβ b"
unfolding gf_def
by (intro exI conjI)
(
cs_concl
cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
)+
next
assume
"βg f b c a.
gf = [g, f]β©β β§
g : b β¦βcat_ordinal Aβ c β§
f : a β¦βcat_ordinal Aβ b"
then obtain g f b c a
where gf_def: "gf = [g, f]β©β"
and g: "g : b β¦βcat_ordinal Aβ c"
and f: "f : a β¦βcat_ordinal Aβ b"
by clarsimp
note g = cat_ordinal_is_arrD[OF g]
note f = cat_ordinal_is_arrD[OF f]
from g(1-3) f(1-3) show "gf ββ©β ordinal_composable A"
unfolding gf_def g(4) f(4)
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
)
qed
show [cat_ordinal_cs_intros]: "g ββ©Aβcat_ordinal Aβ f : a β¦βcat_ordinal Aβ c"
if "g : b β¦βcat_ordinal Aβ c" and "f : a β¦βcat_ordinal Aβ b" for b c g a f
proof-
note g = cat_ordinal_is_arrD[OF that(1)]
note f = cat_ordinal_is_arrD[OF that(2)]
show ?thesis
proof(intro cat_ordinal_is_arrI g(1,2) f(1,2), unfold g(4) f(4))
from g(3) f(3) show "a ββ©β c" by auto
from g(1,2,3) f(1,2,3) show " [b, c]β©β ββ©Aβcat_ordinal Aβ [a, b]β©β = [a, c]β©β"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros
)
qed
qed
show
"h ββ©Aβcat_ordinal Aβ g ββ©Aβcat_ordinal Aβ f =
h ββ©Aβcat_ordinal Aβ (g ββ©Aβcat_ordinal Aβ f)"
if "h : c β¦βcat_ordinal Aβ d"
and "g : b β¦βcat_ordinal Aβ c"
and "f : a β¦βcat_ordinal Aβ b"
for c d h b g a f
proof-
note h = cat_ordinal_is_arrD[OF that(1)]
note g = cat_ordinal_is_arrD[OF that(2)]
note f = cat_ordinal_is_arrD[OF that(3)]
from that(1-3) h(1-3) g(1-4) f(1-3) show ?thesis
unfolding h(4) g(4) f(4)
by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_ordinal_cs_intros)
qed
show "cat_ordinal Aβ¦CIdβ¦β¦aβ¦ : a β¦βcat_ordinal Aβ a"
if "a ββ©β cat_ordinal Aβ¦Objβ¦" for a
proof-
from that have "a ββ©β A" unfolding cat_ordinal_components by simp
then show "cat_ordinal Aβ¦CIdβ¦β¦aβ¦ : a β¦βcat_ordinal Aβ a"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps
cs_intro: cat_ordinal_cs_intros V_cs_intros
)
qed
show "cat_ordinal Aβ¦CIdβ¦β¦bβ¦ ββ©Aβcat_ordinal Aβ f = f"
if "f : a β¦βcat_ordinal Aβ b" for a b f
proof-
note f = cat_ordinal_is_arrD[OF that]
from f(1-3) show ?thesis
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps f(4)
cs_intro: cat_ordinal_cs_intros V_cs_intros
)
qed
show "f ββ©Aβcat_ordinal Aβ cat_ordinal Aβ¦CIdβ¦β¦bβ¦ = f"
if "f : b β¦βcat_ordinal Aβ c" for b c f
proof-
note f = cat_ordinal_is_arrD[OF that]
from f(1-3) show ?thesis
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps f(4)
cs_intro: cat_ordinal_cs_intros V_cs_intros
)
qed
from assms Ord_Ξ± show "cat_ordinal Aβ¦Objβ¦ ββ©β Vset Ξ±"
unfolding cat_ordinal_components by auto
show "(ββ©βbββ©βB. ββ©βcββ©βC. Hom (cat_ordinal A) b c) ββ©β Vset Ξ±"
if "B ββ©β cat_ordinal Aβ¦Objβ¦"
and "C ββ©β cat_ordinal Aβ¦Objβ¦"
and "B ββ©β Vset Ξ±"
and "C ββ©β Vset Ξ±"
for B C
proof-
have "(ββ©βbββ©βB. ββ©βcββ©βC. Hom (cat_ordinal A) b c) ββ©β B Γβ©β C"
proof(rule vsubsetI)
fix f assume "f ββ©β (ββ©βbββ©βB. ββ©βcββ©βC. Hom (cat_ordinal A) b c)"
then obtain b c
where b: "b ββ©β B" and c: "c ββ©β C" and f: "f : b β¦βcat_ordinal Aβ c"
by auto
note f = cat_ordinal_is_arrD[OF f]
from b c show "f ββ©β B Γβ©β C"
unfolding f(4) by auto
qed
moreover from that(3,4) have "B Γβ©β C ββ©β Vset Ξ±"
by (auto intro: Limit_ftimes_in_VsetI)
ultimately show ?thesis by blast
qed
show "(βf. Hom (cat_ordinal A) a b = set {f}) β¨ Hom (cat_ordinal A) a b = 0"
if "a ββ©β cat_ordinal Aβ¦Objβ¦" and "b ββ©β cat_ordinal Aβ¦Objβ¦" for a b
proof-
from that have a: "a ββ©β A" and b: "b ββ©β A"
unfolding cat_ordinal_components by simp_all
then consider βΉa β€ bβΊ | βΉΒ¬a β€ bβΊ by auto
then show ?thesis
proof cases
case 1
with a b have "[a, b]β©β : a β¦βcat_ordinal Aβ b"
by (auto intro: cat_ordinal_is_arrI)
then show ?thesis by (simp add: cat_ordinal_Hom_ne)
qed (simp add: cat_ordinal_Hom_empty)
qed
show "a = b"
if "a ββ©β cat_ordinal Aβ¦Objβ¦"
and "b ββ©β cat_ordinal Aβ¦Objβ¦"
and "a β€β©Oβcat_ordinal Aβ b"
and "b β€β©Oβcat_ordinal Aβ a"
for a b
using
that(3,4)[unfolded cat_ordinal_is_le_iff cat_ordinal_components]
cat_ordinal_is_arr_is_unique
by auto
show "a β€β©Oβcat_ordinal Aβ b β¨ b β€β©Oβcat_ordinal Aβ a"
if "a ββ©β cat_ordinal Aβ¦Objβ¦" and "b ββ©β cat_ordinal Aβ¦Objβ¦" for a b
proof-
from that[unfolded cat_ordinal_components] have a: "a ββ©β A" and b: "b ββ©β A"
by simp_all
with assms have "Ord a" "Ord b" by auto
then consider βΉa β€ bβΊ | βΉb β€ aβΊ by (meson Ord_linear_le)
then show "a β€β©Oβcat_ordinal Aβ b β¨ b β€β©Oβcat_ordinal Aβ a"
by cases (auto simp: a b cat_ordinal_is_le_iff intro: cat_ordinal_is_arrI)
qed
qed (auto intro: cat_ordinal_cs_intros simp: cat_ordinal_cs_simps)
lemmas [cat_ordinal_cs_intros] = π΅.cat_linear_order_cat_ordinal
lemma (in π΅) cat_tiny_linear_order_cat_ordinal[cat_ordinal_cs_intros]:
assumes "Ord A" and "A ββ©β Ξ±"
shows "cat_tiny_linear_order Ξ± (cat_ordinal A)"
proof(intro cat_tiny_linear_orderI' cat_linear_order_cat_ordinal assms(1))
from assms show "A ββ©β Ξ±"
by (meson Ord_Ξ± Ord_linear_le mem_not_refl vsubsetE)
from assms(1) this interpret A: cat_linear_order Ξ± βΉcat_ordinal AβΊ
by (intro cat_linear_order_cat_ordinal)
from assms(2) have A_in_Vset: "A ββ©β Vset Ξ±" by (simp add: Ord_Ξ± Ord_in_in_VsetI)
have "cat_ordinal Aβ¦Arrβ¦ ββ©β A Γβ©β A"
unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
moreover from A_in_Vset have "A Γβ©β A ββ©β Vset Ξ±"
by (intro Limit_ftimes_in_VsetI) auto
ultimately have "cat_ordinal Aβ¦Arrβ¦ ββ©β Vset Ξ±"
using vsubset_in_VsetI unfolding cat_ordinal_components by simp
moreover have "cat_ordinal Aβ¦Objβ¦ ββ©β Vset Ξ±"
unfolding cat_ordinal_components by (intro A_in_Vset)
ultimately show "tiny_category Ξ± (cat_ordinal A)"
by (cs_concl cs_intro: cat_cs_intros tiny_categoryI')
qed
lemmas [cat_ordinal_cs_intros] = π΅.cat_linear_order_cat_ordinal
lemma (in π΅) finite_category_cat_ordinal[cat_ordinal_cs_intros]:
assumes "a ββ©β Ο"
shows "finite_category Ξ± (cat_ordinal a)"
proof-
from assms have "Ord a" "a ββ©β Ξ±" by (auto simp: Ord_Ξ± Ord_trans)
then interpret cat_ordinal: cat_tiny_linear_order Ξ± βΉcat_ordinal aβΊ
by (cs_concl cs_intro: cat_ordinal_cs_intros)
show ?thesis
proof(intro finite_categoryI')
from assms show "category Ξ± (cat_ordinal a)"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "vfinite (cat_ordinal aβ¦Objβ¦)"
unfolding cat_ordinal_components by auto
from assms show "vfinite (cat_ordinal aβ¦Arrβ¦)"
proof-
have "cat_ordinal aβ¦Arrβ¦ ββ©β a Γβ©β a"
unfolding cat_ordinal_components by auto
moreover from assms have "vfinite (a Γβ©β a)"
by (intro vfinite_ftimesI) auto
ultimately show ?thesis by (auto simp: vfinite_vsubset)
qed
qed
qed
lemmas [cat_ordinal_cs_intros] = π΅.finite_category_cat_ordinal
end
Theory CZH_ECAT_CSimplicial
sectionβΉSimplicial categoryβΊ
theory CZH_ECAT_CSimplicial
imports CZH_ECAT_Ordinal
begin
subsectionβΉBackgroundβΊ
textβΉ
The content of this section is based, primarily, on the elements of the
content of Chapter I-2 in \cite{mac_lane_categories_2010}.
βΊ
named_theorems cat_simplicial_cs_simps
named_theorems cat_simplicial_cs_intros
subsectionβΉComposable arrows for simplicial categoryβΊ
definition composable_cat_simplicial :: "V β V β V"
where "composable_cat_simplicial Ξ± A = set
{
[g, f]β©β | g f. βm n p.
g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p β§
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§
m ββ©β A β§ n ββ©β A β§ p ββ©β A
}"
lemma small_composable_cat_simplicial[simp]:
"small
{
[g, f]β©β | g f. βm n p.
g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p β§
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§
m ββ©β A β§ n ββ©β A β§ p ββ©β A
}"
(is βΉsmall ?SβΊ)
proof(rule down)
show "?S β elts (all_cfs Ξ± Γβ©β all_cfs Ξ±)"
proof
(
intro subsetI,
unfold mem_Collect_eq, elim exE conjE; simp only:; intro ftimesI2
)
fix m n p g f
assume prems:
"m ββ©β A"
"n ββ©β A"
"p ββ©β A"
"g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
"f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
interpret g: is_preorder_functor Ξ± βΉcat_ordinal nβΊ βΉcat_ordinal pβΊ g
by (rule prems(4))
interpret f: is_preorder_functor Ξ± βΉcat_ordinal mβΊ βΉcat_ordinal nβΊ f
by (rule prems(5))
from g.is_functor_axioms show "g ββ©β all_cfs Ξ±" by auto
from f.is_functor_axioms show "f ββ©β all_cfs Ξ±" by auto
qed
qed
textβΉRules.βΊ
lemma composable_cat_simplicialI:
assumes "g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
and "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
and "p ββ©β A"
and "gf = [g, f]β©β"
shows "gf ββ©β composable_cat_simplicial Ξ± A"
using assms
unfolding composable_cat_simplicial_def
by (intro in_small_setI small_composable_cat_simplicial) auto
lemma composable_cat_simplicialE[elim]:
assumes "gf ββ©β composable_cat_simplicial Ξ± A"
obtains g f m n p where "gf = [g, f]β©β"
and "g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
and "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
and "p ββ©β A"
proof-
from assms obtain g f m n p where
"gf = [g, f]β©β"
"g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
"f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
"m ββ©β A"
"n ββ©β A"
"p ββ©β A"
unfolding composable_cat_simplicial_def
by (elim in_small_setE, intro small_composable_cat_simplicial) auto
with that show ?thesis by auto
qed
subsectionβΉSimplicial categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition cat_simplicial :: "V β V β V"
where "cat_simplicial Ξ± A =
[
set {cat_ordinal m | m. m ββ©β A},
set
{
f. βm n.
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A
},
(
Ξ»fββ©β set
{
f. βm n.
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A
}. fβ¦HomDomβ¦
),
(
Ξ»fββ©β set
{
f. βm n.
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A
}. fβ¦HomCodβ¦
),
(Ξ»gfββ©βcomposable_cat_simplicial Ξ± A. gfβ¦0β¦ ββ©Cβ©F gfβ¦1β©ββ¦),
(Ξ»mββ©βset {cat_ordinal m | m. m ββ©β A}. cf_id m)
]β©β"
textβΉComponents.βΊ
lemma cat_simplicial_components:
shows "cat_simplicial Ξ± Aβ¦Objβ¦ = set {cat_ordinal m | m. m ββ©β A}"
and "cat_simplicial Ξ± Aβ¦Arrβ¦ =
set {f. βm n. f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A}"
and "cat_simplicial Ξ± Aβ¦Domβ¦ =
(
Ξ»fββ©βset
{
f. βm n.
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A
}. fβ¦HomDomβ¦
)"
and "cat_simplicial Ξ± Aβ¦Codβ¦ =
(
Ξ»fββ©βset
{
f. βm n.
f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A
}. fβ¦HomCodβ¦
)"
and "cat_simplicial Ξ± Aβ¦Compβ¦ =
(Ξ»gfββ©βcomposable_cat_simplicial Ξ± A. gfβ¦0β¦ ββ©Cβ©F gfβ¦1β©ββ¦)"
and "cat_simplicial Ξ± Aβ¦CIdβ¦ =
(Ξ»mββ©βset {cat_ordinal m | m. m ββ©β A}. cf_id m)"
unfolding cat_simplicial_def dg_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉObjectsβΊ
lemma cat_simplicial_ObjI[cat_simplicial_cs_intros]:
assumes "m ββ©β A" and "a = cat_ordinal m"
shows "a ββ©β cat_simplicial Ξ± Aβ¦Objβ¦ "
using assms unfolding cat_simplicial_components by auto
lemma cat_simplicial_ObjD:
assumes "cat_ordinal m ββ©β cat_simplicial Ξ± Aβ¦Objβ¦ "
shows "m ββ©β A"
using assms cat_ordinal_inj unfolding cat_simplicial_components by auto
lemma cat_simplicial_ObjE:
assumes "M ββ©β cat_simplicial Ξ± Aβ¦Objβ¦ "
obtains m where "M = cat_ordinal m" and "m ββ©β A"
using assms cat_ordinal_inj that unfolding cat_simplicial_components by auto
subsubsectionβΉArrowsβΊ
lemma small_cat_simplicial_Arr[simp]:
"small {f. βm n. f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n β§ m ββ©β A β§ n ββ©β A}"
(is βΉsmall ?SβΊ)
proof(rule down)
show "?S β elts (all_cfs Ξ±)" by auto
qed
lemma cat_simplicial_ArrI[cat_simplicial_cs_intros]:
assumes "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n" and "m ββ©β A" and "n ββ©β A"
shows "f ββ©β cat_simplicial Ξ± Aβ¦Arrβ¦"
using assms
unfolding cat_simplicial_components
by (intro in_small_setI small_cat_simplicial_Arr) auto
lemma cat_simplicial_ArrE:
assumes "f ββ©β cat_simplicial Ξ± Aβ¦Arrβ¦"
obtains m n
where "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n" and "m ββ©β A" and "n ββ©β A"
proof-
from assms cat_ordinal_inj obtain m n
where "m ββ©β A" "n ββ©β A" "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
unfolding cat_simplicial_components
by (elim in_small_setE, intro small_cat_simplicial_Arr) auto
with that show ?thesis by simp
qed
subsubsectionβΉDomainβΊ
mk_VLambda cat_simplicial_components(3)
|vsv cat_simplicial_Dom_vsv[cat_simplicial_cs_intros]|
|vdomain
cat_simplicial_Dom_vdomain[
folded cat_simplicial_components, cat_simplicial_cs_simps
]
|
|app cat_simplicial_Dom_app[folded cat_simplicial_components]|
lemma cat_simplicial_Dom_app'[cat_simplicial_cs_simps]:
assumes "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n" and "m ββ©β A" and "n ββ©β A"
shows "cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ = cat_ordinal m"
proof-
interpret f: is_preorder_functor Ξ± βΉcat_ordinal mβΊ βΉcat_ordinal nβΊ f
by (rule assms(1))
from assms show "cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ = cat_ordinal m"
by
(
cs_concl
cs_simp: cat_cs_simps cat_simplicial_Dom_app
cs_intro: cat_simplicial_cs_intros
)
qed
subsubsectionβΉCodomainβΊ
mk_VLambda cat_simplicial_components(4)
|vsv cat_simplicial_Cod_vsv[cat_simplicial_cs_intros]|
|vdomain
cat_simplicial_Cod_vdomain[
folded cat_simplicial_components, cat_simplicial_cs_simps
]
|
|app cat_simplicial_Cod_app[folded cat_simplicial_components]|
lemma cat_simplicial_Cod_app'[cat_simplicial_cs_simps]:
assumes "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n" and "m ββ©β A" and "n ββ©β A"
shows "cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ = cat_ordinal n"
proof-
interpret f: is_preorder_functor Ξ± βΉcat_ordinal mβΊ βΉcat_ordinal nβΊ f
by (rule assms(1))
from assms show "cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ = cat_ordinal n"
by
(
cs_concl
cs_simp: cat_cs_simps cat_simplicial_Cod_app
cs_intro: cat_simplicial_cs_intros
)
qed
subsubsectionβΉArrow with a domain and a codomainβΊ
lemma cat_simplicial_is_arrI:
assumes "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
shows "f : cat_ordinal m β¦βcat_simplicial Ξ± Aβ cat_ordinal n"
proof(intro is_arrI cat_simplicial_ArrI, rule assms; (intro assms(2,3))?)
from assms show
"cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ = cat_ordinal m"
"cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ = cat_ordinal n"
by (cs_concl cs_simp: cat_simplicial_cs_simps)+
qed
lemma cat_simplicial_is_arrI'[cat_simplicial_cs_intros]:
assumes "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
and "a = cat_ordinal m"
and "b = cat_ordinal n"
shows "f : a β¦βcat_simplicial Ξ± Aβ b"
using assms(1-3) unfolding assms(4-5) by (rule cat_simplicial_is_arrI)
lemma cat_simplicial_is_arrD[dest]:
assumes "f : cat_ordinal m β¦βcat_simplicial Ξ± Aβ cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
shows "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
proof-
note f = is_arrD[OF assms(1)]
from f(1) obtain m' n'
where f_is_preorder_functor: "f : cat_ordinal m' β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n'"
and "m' ββ©β A"
and "n' ββ©β A"
by (elim cat_simplicial_ArrE)
then have
"cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ = cat_ordinal m'"
"cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ = cat_ordinal n'"
by (cs_concl cs_simp: cat_simplicial_cs_simps)+
with f(2,3) have
"cat_ordinal m' = cat_ordinal m" "cat_ordinal n' = cat_ordinal n"
by auto
with f(2,3) cat_ordinal_inj have [simp]: "m' = m" "n' = n" by auto
from f_is_preorder_functor show ?thesis by simp
qed
lemma cat_simplicial_is_arrE[elim]:
assumes "f : a β¦βcat_simplicial Ξ± Aβ b"
obtains m n where "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
and "a = cat_ordinal m"
and "b = cat_ordinal n"
proof-
note f = is_arrD[OF assms(1)]
from f(1) obtain m n
where f_is_preorder_functor: "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and m: "m ββ©β A"
and n: "n ββ©β A"
by (elim cat_simplicial_ArrE)
then have
"cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ = cat_ordinal m"
"cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ = cat_ordinal n"
by (cs_concl cs_simp: cat_simplicial_cs_simps)+
with f(2,3) have "cat_ordinal m = a" "cat_ordinal n = b"
by auto
with f_is_preorder_functor m n that show ?thesis by auto
qed
subsubsectionβΉCompositionβΊ
mk_VLambda cat_simplicial_components(5)
|vsv cat_simplicial_Comp_vsv[cat_simplicial_cs_intros]|
|vdomain cat_simplicial_Comp_vdomain[cat_simplicial_cs_simps]|
lemma cat_simplicial_Comp_app[cat_simplicial_cs_simps]:
assumes "g : cat_ordinal n β¦βcat_simplicial Ξ± Aβ cat_ordinal p"
and "f : cat_ordinal m β¦βcat_simplicial Ξ± Aβ cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
and "p ββ©β A"
shows "g ββ©Aβcat_simplicial Ξ± Aβ f = g ββ©Cβ©F f"
proof-
note g = cat_simplicial_is_arrD[OF assms(1,4,5)]
note f = cat_simplicial_is_arrD[OF assms(2,3,4)]
interpret g: is_preorder_functor Ξ± βΉcat_ordinal nβΊ βΉcat_ordinal pβΊ g
by (rule g)
interpret f: is_preorder_functor Ξ± βΉcat_ordinal mβΊ βΉcat_ordinal nβΊ f
by (rule f)
have "[g, f]β©β ββ©β composable_cat_simplicial Ξ± A"
by
(
intro composable_cat_simplicialI, rule g, rule f;
(intro assms refl)?
)
then show "g ββ©Aβcat_simplicial Ξ± Aβ f = g ββ©Cβ©F f"
unfolding cat_simplicial_components by (simp add: nat_omega_simps)
qed
subsubsectionβΉIdentityβΊ
context
fixes Ξ± A :: V
begin
mk_VLambda cat_simplicial_components(6)[where Ξ±=Ξ± and A=A]
|vsv cat_simplicial_CId_vsv[cat_simplicial_cs_intros]|
|vdomain
cat_simplicial_CId_vdomain'[
folded cat_simplicial_components(1)[where Ξ±=Ξ± and A=A]
]
|
|app cat_simplicial_CId_app'[
folded cat_simplicial_components(1)[where Ξ±=Ξ± and A=A]
]
|
lemmas cat_simplicial_CId_vdomain[cat_simplicial_cs_simps] =
cat_simplicial_CId_vdomain'
lemmas cat_simplicial_CId_app[cat_simplicial_cs_simps] =
cat_simplicial_CId_app'
end
subsubsectionβΉSimplicial category is a categoryβΊ
lemma (in π΅) category_simplicial:
assumes "Ord A" and "A ββ©β Ξ±"
shows "category Ξ± (cat_simplicial Ξ± A)"
proof-
show ?thesis
proof(intro categoryI')
show "vfsequence (cat_simplicial Ξ± A)" unfolding cat_simplicial_def by simp
show "vcard (cat_simplicial Ξ± A) = 6β©β"
unfolding cat_simplicial_def by (simp add: nat_omega_simps)
show "ββ©β (cat_simplicial Ξ± Aβ¦Domβ¦) ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_simplicial_cs_simps)
fix f assume "f ββ©β cat_simplicial Ξ± Aβ¦Arrβ¦"
then obtain m n
where "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
by (elim cat_simplicial_ArrE)
then show "cat_simplicial Ξ± Aβ¦Domβ¦β¦fβ¦ ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
by (auto simp: cat_simplicial_Dom_app' intro: cat_simplicial_ObjI)
qed (auto simp: cat_simplicial_components)
show "ββ©β (cat_simplicial Ξ± Aβ¦Codβ¦) ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_simplicial_cs_simps)
fix f assume "f ββ©β cat_simplicial Ξ± Aβ¦Arrβ¦"
then obtain m n
where "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and "m ββ©β A"
and "n ββ©β A"
by (elim cat_simplicial_ArrE)
then show "cat_simplicial Ξ± Aβ¦Codβ¦β¦fβ¦ ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
by (auto simp: cat_simplicial_Cod_app' intro: cat_simplicial_ObjI)
qed (auto simp: cat_simplicial_components)
show "(gf ββ©β πβ©β (cat_simplicial Ξ± Aβ¦Compβ¦)) β·
(
βg f b c a.
gf = [g, f]β©β β§
g : b β¦βcat_simplicial Ξ± Aβ c β§
f : a β¦βcat_simplicial Ξ± Aβ b
)"
for gf
proof(intro iffI; (elim exE conjE)?)
assume "gf ββ©β πβ©β (cat_simplicial Ξ± Aβ¦Compβ¦)"
then have "gf ββ©β composable_cat_simplicial Ξ± A"
unfolding cat_simplicial_components by simp
then obtain g f m n p
where gf_def: "gf = [g, f]β©β"
and g: "g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
and f: "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and m: "m ββ©β A"
and n: "n ββ©β A"
and p: "p ββ©β A"
by auto
show "βg f b c a.
gf = [g, f]β©β β§
g : b β¦βcat_simplicial Ξ± Aβ c β§
f : a β¦βcat_simplicial Ξ± Aβ b"
proof(intro exI conjI)
from g n p show "g : cat_ordinal n β¦βcat_simplicial Ξ± Aβ cat_ordinal p"
by (intro cat_simplicial_is_arrI) simp_all
from f m n show "f : cat_ordinal m β¦βcat_simplicial Ξ± Aβ cat_ordinal n"
by (intro cat_simplicial_is_arrI) simp_all
qed (simp add: gf_def)
next
fix g f a b c assume prems:
"gf = [g, f]β©β"
"g : b β¦βcat_simplicial Ξ± Aβ c"
"f : a β¦βcat_simplicial Ξ± Aβ b"
from prems(2) obtain n p
where g: "g : cat_ordinal n β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal p"
and n: "n ββ©β A"
and p: "p ββ©β A"
and b_def: "b = cat_ordinal n"
and "c = cat_ordinal p"
by auto
from prems(3) obtain m n'
where f: "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n'"
and m: "m ββ©β A"
and n': "n' ββ©β A"
and a_def: "a = cat_ordinal m"
and b_def': "b = cat_ordinal n'"
by auto
from b_def b_def' have n'n: "n' = n" by (auto simp: cat_ordinal_inj)
show "gf ββ©β πβ©β (cat_simplicial Ξ± Aβ¦Compβ¦)"
unfolding prems(1) cat_simplicial_Comp_vdomain
by (intro composable_cat_simplicialI, rule g, rule f[unfolded n'n])
(simp_all add: m n p)
qed
show "g ββ©Aβcat_simplicial Ξ± Aβ f : a β¦βcat_simplicial Ξ± Aβ c"
if "g : b β¦βcat_simplicial Ξ± Aβ c" and "f : a β¦βcat_simplicial Ξ± Aβ b"
for b c g a f
using that
by (elim cat_simplicial_is_arrE; simp only: cat_ordinal_inj)
(
cs_concl
cs_simp: cat_simplicial_cs_simps
cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
)
show "h ββ©Aβcat_simplicial Ξ± Aβ g ββ©Aβcat_simplicial Ξ± Aβ f =
h ββ©Aβcat_simplicial Ξ± Aβ (g ββ©Aβcat_simplicial Ξ± Aβ f)"
if "h : c β¦βcat_simplicial Ξ± Aβ d"
and "g : b β¦βcat_simplicial Ξ± Aβ c"
and "f : a β¦βcat_simplicial Ξ± Aβ b"
for c d h b g a f
using that
apply(elim cat_simplicial_is_arrE; simp only:)
subgoal for m n m' n' m'' n''
by
(
cs_concl
cs_simp: cat_cs_simps cat_simplicial_cs_simps
cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
)+
done
show "cat_simplicial Ξ± Aβ¦CIdβ¦β¦aβ¦ : a β¦βcat_simplicial Ξ± Aβ a"
if "a ββ©β cat_simplicial Ξ± Aβ¦Objβ¦" for a
using that
proof(elim cat_simplicial_ObjE; simp only:)
fix m assume prems: "m ββ©β A" "cat_ordinal m ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
moreover from prems(1) assms(1) have "Ord m" by auto
moreover from prems assms have "m ββ©β Ξ±"
by (meson Ord_trans vsubsetI rev_vsubsetD)
ultimately show "cat_simplicial Ξ± Aβ¦CIdβ¦β¦cat_ordinal mβ¦ :
cat_ordinal m β¦βcat_simplicial Ξ± Aβ cat_ordinal m"
by
(
cs_concl
cs_simp: cat_simplicial_cs_simps
cs_intro:
cat_ordinal_cs_intros
cat_order_cs_intros
cat_simplicial_cs_intros
)
qed
show "cat_simplicial Ξ± Aβ¦CIdβ¦β¦bβ¦ ββ©Aβcat_simplicial Ξ± Aβ f = f"
if "f : a β¦βcat_simplicial Ξ± Aβ b" for a b f
using that
by (elim cat_simplicial_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_simplicial_cs_simps
cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
)
show "f ββ©Aβcat_simplicial Ξ± Aβ cat_simplicial Ξ± Aβ¦CIdβ¦β¦bβ¦ = f"
if "f : b β¦βcat_simplicial Ξ± Aβ c" for b c f
using that
by (elim cat_simplicial_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_simplicial_cs_simps
cs_intro: cat_order_cs_intros cat_simplicial_cs_intros
)
show "cat_simplicial Ξ± Aβ¦Objβ¦ ββ©β Vset Ξ±"
proof(intro vsubsetI, elim cat_simplicial_ObjE; simp only:)
fix m assume prems: "m ββ©β A"
then have "Ord m" using assms(1) by auto
moreover from prems have "m ββ©β Ξ±" using assms(2) by auto
ultimately interpret m: cat_tiny_linear_order Ξ± βΉcat_ordinal mβΊ
by (intro cat_tiny_linear_order_cat_ordinal)
show "cat_ordinal m ββ©β Vset Ξ±" by (rule m.tiny_cat_in_Vset)
qed
show "(ββ©βaββ©βA'. ββ©βbββ©βB'. Hom (cat_simplicial Ξ± A) a b) ββ©β Vset Ξ±"
if "A' ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
and "B' ββ©β cat_simplicial Ξ± Aβ¦Objβ¦"
and "A' ββ©β Vset Ξ±"
and "B' ββ©β Vset Ξ±"
for A' B'
proof-
define Q where "Q i =
(
if i = 0 β VPow ((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦))
| i = 1β©β β VPow
(((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦)))
| i = 2β©β β A'
| i = 3β©β β B'
| otherwise β 0
)"
for i
let ?Q =
βΉ{
[fo, fa, a, b]β©β | fo fa a b.
fo ββ©β ((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦)) β§
fa ββ©β
((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦)) β§
a ββ©β A' β§
b ββ©β B'
}βΊ
have QQ: "?Q β elts (ββ©βiββ©βset {0, 1β©β, 2β©β, 3β©β}. Q i)"
proof(intro subsetI, unfold mem_Collect_eq, elim exE conjE)
fix x fo fa a b assume prems:
"x = [fo, fa, a, b]β©β"
"fo ββ©β ((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦))"
"fa ββ©β
((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦))"
"a ββ©β A'"
"b ββ©β B'"
show "x ββ©β (ββ©βiββ©βset {0, 1β©β, 2β©β, 3β©β}. Q i)"
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "πβ©β x = set {[]β©β, 1β©β, 2β©β, 3β©β}"
unfolding prems(1) by (force simp: nat_omega_simps)
fix i assume "i ββ©β set {0, 1β©β, 2β©β, 3β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ | βΉi = 3β©ββΊ by auto
then show "xβ¦iβ¦ ββ©β Q i"
by cases (auto simp: Q_def prems nat_omega_simps)
qed (auto simp: prems)
qed
then have small_Q[simp]: "small ?Q" by (intro down)
have "(ββ©βaββ©βA'. ββ©βbββ©βB'. Hom (cat_simplicial Ξ± A) a b) ββ©β set ?Q"
proof(intro vsubsetI in_small_setI small_Q)
fix f assume "f ββ©β (ββ©βaββ©βA'. ββ©βbββ©βB'. Hom (cat_simplicial Ξ± A) a b)"
then obtain a b
where a: "a ββ©β A'"
and b: "b ββ©β B'"
and "f : a β¦βcat_simplicial Ξ± Aβ b"
by auto
then obtain m n
where f: "f : cat_ordinal m β€β©Cβ©.β©Pβ©Eβ©OβΞ±β cat_ordinal n"
and m: "m ββ©β A"
and n: "n ββ©β A"
and a_def: "a = cat_ordinal m"
and b_def: "b = cat_ordinal n"
by auto
interpret f: is_preorder_functor Ξ± βΉcat_ordinal mβΊ βΉcat_ordinal nβΊ f
by (rule f)
show "f β ?Q"
proof(unfold mem_Collect_eq, intro exI conjI)
show "fβ¦ObjMapβ¦ ββ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦)"
proof(intro vsubsetI)
fix x assume prems: "x ββ©β fβ¦ObjMapβ¦"
obtain xl xr
where x_def: "x = β¨xl, xrβ©"
and xl: "xl ββ©β cat_ordinal mβ¦Objβ¦"
and xr: "xr ββ©β (ββ©β (fβ¦ObjMapβ¦))"
by (elim f.ObjMap.vbrelation_vinE[OF prems, unfolded cat_cs_simps])
show "x ββ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦)"
unfolding x_def
proof(standard; (intro vifunionI))
from xr f.cf_ObjMap_vrange show "xr ββ©β cat_ordinal nβ¦Objβ¦" by auto
qed (use a b in βΉauto intro: xl simp: a_def b_defβΊ)
qed
show "fβ¦ArrMapβ¦ ββ©β
((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦))"
proof(intro vsubsetI)
fix x assume prems: "x ββ©β fβ¦ArrMapβ¦"
obtain xl xr
where x_def: "x = β¨xl, xrβ©"
and xl: "xl ββ©β cat_ordinal mβ¦Arrβ¦"
and xr: "xr ββ©β (ββ©β (fβ¦ArrMapβ¦))"
by (elim f.ArrMap.vbrelation_vinE[OF prems, unfolded cat_cs_simps])
from xr vsubsetD have xr: "xr ββ©β cat_ordinal nβ¦Arrβ¦"
by (auto intro: f.cf_ArrMap_vrange)
from xl obtain xll xlr where xl_def: "xl = [xll, xlr]β©β"
and xll_m: "xll ββ©β m"
and xlr_m: "xlr ββ©β m"
and "xll ββ©β xlr"
unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
from xr obtain xrl xrr where xr_def: "xr = [xrl, xrr]β©β"
and xrl_n: "xrl ββ©β n"
and xrr_n:"xrr ββ©β n"
and "xrl ββ©β xrr"
unfolding ordinal_arrs_def cat_ordinal_components by clarsimp
show "x ββ©β
((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦))"
unfolding x_def
by (standard; (intro vifunionI ftimesI1)?)
(
use a b in βΉ
auto
simp: xl_def xr_def a_def b_def cat_ordinal_components
intro: xrr_n xrl_n xlr_m xll_m
βΊ
)
qed
qed
(
auto
simp: cat_cs_simps
intro: a[unfolded a_def] b[unfolded b_def] f.cf_def
)
qed
moreover have "set ?Q ββ©β (ββ©βiββ©βset {0, 1β©β, 2β©β, 3β©β}. Q i)"
by
(
intro vsubset_if_subset,
unfold small_elts_of_set[OF small_Q],
intro QQ
)
moreover have "(ββ©βiββ©βset {0, 1β©β, 2β©β, 3β©β}. Q i) ββ©β Vset Ξ±"
proof(intro Limit_vproduct_in_VsetI)
show "set {0, 1β©β, 2β©β, 3β©β} ββ©β Vset Ξ±"
unfolding four[symmetric] by simp
have "(ββ©βa'ββ©βA'. a'β¦Objβ¦) ββ©β ββ©β(ββ©βrββ©βA'. ββ©β r)"
proof(intro vsubsetI)
fix x assume "x ββ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)"
then obtain a' where a': "a' ββ©β A'" and x: "x ββ©β a'β¦Objβ¦" by auto
from a' that(1) have "a' ββ©β cat_simplicial Ξ± Aβ¦Objβ¦" by auto
then obtain m where a'_def: "a' = cat_ordinal m" and m: "m ββ©β A"
unfolding cat_simplicial_components by clarsimp
show "x ββ©β ββ©β(ββ©βrββ©βA'. ββ©β r)"
proof(rule VUnionI, rule vifunionI)
from a'_def have "vsv a'" and "Obj ββ©β πβ©β a'"
unfolding a'_def cat_ordinal_def Obj_def by auto
then show "a'β¦Objβ¦ ββ©β ββ©β a'" by auto
qed (auto simp: x a')
qed
moreover have "(ββ©βrββ©βA'. ββ©β r) ββ©β Vset Ξ±"
by (intro Limit_VUnion_vrange_in_VsetI[OF Limit_Ξ±] that)
ultimately have UA': "(ββ©βa'ββ©βA'. a'β¦Objβ¦) ββ©β Vset Ξ±" by blast
have B': "(ββ©βb'ββ©βB'. b'β¦Objβ¦) ββ©β ββ©β(ββ©βrββ©βB'. ββ©β r)"
proof(intro vsubsetI)
fix x assume "x ββ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦)"
then obtain b' where b': "b' ββ©β B'" and x: "x ββ©β b'β¦Objβ¦" by auto
from b' that(2) have "b' ββ©β cat_simplicial Ξ± Aβ¦Objβ¦" by auto
then obtain m where b'_def: "b' = cat_ordinal m" and m: "m ββ©β A"
unfolding cat_simplicial_components by clarsimp
show "x ββ©β ββ©β(ββ©βrββ©βB'. ββ©β r)"
proof(rule VUnionI, rule vifunionI)
from b'_def have "vsv b'" and "Obj ββ©β πβ©β b'"
unfolding b'_def cat_ordinal_def Obj_def by auto
then show "b'β¦Objβ¦ ββ©β ββ©β b'" by auto
qed (auto simp: x b')
qed
moreover have "(ββ©βrββ©βB'. ββ©β r) ββ©β Vset Ξ±"
by (intro Limit_VUnion_vrange_in_VsetI[OF Limit_Ξ±] that)
ultimately have UB': "(ββ©βa'ββ©βB'. a'β¦Objβ¦) ββ©β Vset Ξ±" by blast
have [simp]:
"VPow ((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βb'ββ©βB'. b'β¦Objβ¦)) ββ©β Vset Ξ±"
by (intro Limit_VPow_in_VsetI Limit_vtimes_in_VsetI UA' UB') auto
have [simp]:
"VPow
(
((ββ©βa'ββ©βA'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βA'. a'β¦Objβ¦)) Γβ©β
((ββ©βa'ββ©βB'. a'β¦Objβ¦) Γβ©β (ββ©βa'ββ©βB'. a'β¦Objβ¦))
) ββ©β Vset Ξ±"
by
(
intro
Limit_VPow_in_VsetI
Limit_vtimes_in_VsetI
Limit_ftimes_in_VsetI
UA' UB'
)
auto
fix i assume "i ββ©β set {0, 1β©β, 2β©β, 3β©β}"
then consider βΉi = 0βΊ | βΉi = 1β©ββΊ | βΉi = 2β©ββΊ | βΉi = 3β©ββΊ by auto
then show "Q i ββ©β Vset Ξ±"
by cases (simp_all add: Q_def that nat_omega_simps)
qed auto
ultimately show ?thesis by (simp add: vsubset_in_VsetI)
qed
qed (auto simp: cat_simplicial_components)
qed
textβΉ\newpageβΊ
end
Theory CZH_ECAT_Structure_Example
sectionβΉExample: categories with additional structureβΊ
theory CZH_ECAT_Structure_Example
imports
CZH_ECAT_Introduction
CZH_ECAT_PCategory
CZH_ECAT_Set
begin
subsectionβΉBackgroundβΊ
textβΉ
The examples that are presented in this section showcase
how the framework developed in this article can
be used for the formalization of the theory of
categories with additional structure. The content of
this section also indicates some of the potential
future directions for this body of work.
βΊ
subsectionβΉDagger categoryβΊ
named_theorems dag_field_simps
named_theorems catdag_cs_simps
named_theorems catdag_cs_intros
definition DagCat :: V where [dag_field_simps]: "DagCat = 0"
definition DagDag :: V where [dag_field_simps]: "DagDag = 1β©β"
abbreviation DagDag_app :: "V β V" (βΉβ β©CβΊ)
where "β β©C β β‘ ββ¦DagDagβ¦"
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
For further information see
\cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/dagger+category
}}.
βΊ
locale dagger_category =
π΅ Ξ± +
vfsequence β +
DagCat: category Ξ± βΉββ¦DagCatβ¦βΊ +
DagDag: is_functor Ξ± βΉop_cat (ββ¦DagCatβ¦)βΊ βΉββ¦DagCatβ¦βΊ βΉβ β©C ββΊ
for Ξ± β +
assumes catdag_length: "vcard β = 2β©β"
and catdag_ObjMap_identity[catdag_cs_simps]:
"a ββ©β ββ¦DagCatβ¦β¦Objβ¦ βΉ (β β©C β)β¦ObjMapβ¦β¦aβ¦ = a"
and catdag_DagCat_idem[catdag_cs_simps]:
"β β©C β β©Cβ©Fβ β β©C β = cf_id (ββ¦DagCatβ¦)"
lemmas [catdag_cs_simps] =
dagger_category.catdag_ObjMap_identity
dagger_category.catdag_DagCat_idem
textβΉRules.βΊ
lemma (in dagger_category) dagger_category_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "dagger_category Ξ±' β"
unfolding assms by (rule dagger_category_axioms)
mk_ide rf dagger_category_def[unfolded dagger_category_axioms_def]
|intro dagger_categoryI|
|dest dagger_categoryD[dest]|
|elim dagger_categoryE[elim]|
lemma category_if_dagger_category[catdag_cs_intros]:
assumes "β' = (ββ¦DagCatβ¦)" and "dagger_category Ξ± β"
shows "category Ξ± β'"
unfolding assms(1) using assms(2) by (rule dagger_categoryD(3))
lemma (in dagger_category) catdag_is_functor'[catdag_cs_intros]:
assumes "π' = op_cat (ββ¦DagCatβ¦)" and "π
' = ββ¦DagCatβ¦"
shows "β β©C β : π' β¦β¦β©CβΞ±β π
'"
unfolding assms by (rule DagDag.is_functor_axioms)
lemmas [catdag_cs_intros] = dagger_category.catdag_is_functor'
subsectionβΉβΉRelβΊ as a dagger categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
For further information see
\cite{noauthor_nlab_nodate}\footnote{\url{
https://ncatlab.org/nlab/show/Rel
}}.
βΊ
definition dagcat_Rel :: "V β V"
where "dagcat_Rel Ξ± = [cat_Rel Ξ±, β β©Cβ©.β©Rβ©eβ©l Ξ±]β©β"
textβΉComponents.βΊ
lemma dagcat_Rel_components:
shows "dagcat_Rel Ξ±β¦DagCatβ¦ = cat_Rel Ξ±"
and "dagcat_Rel Ξ±β¦DagDagβ¦ = β β©Cβ©.β©Rβ©eβ©l Ξ±"
unfolding dagcat_Rel_def dag_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉβΉRelβΊ is a dagger categoryβΊ
lemma (in π΅) "dagger_category Ξ± (dagcat_Rel Ξ±)"
proof(intro dagger_categoryI)
show "category Ξ± (dagcat_Rel Ξ±β¦DagCatβ¦)"
by (cs_concl cs_simp: dagcat_Rel_components cs_intro: cat_Rel_cs_intros)
show "β β©C (dagcat_Rel Ξ±) :
op_cat (dagcat_Rel Ξ±β¦DagCatβ¦) β¦β¦β©CβΞ±β dagcat_Rel Ξ±β¦DagCatβ¦"
unfolding dagcat_Rel_components
by (cs_concl cs_intro: cf_cs_intros cat_cs_intros)
show "vcard (dagcat_Rel Ξ±) = 2β©β"
unfolding dagcat_Rel_def by (simp add: nat_omega_simps)
show "β β©C (dagcat_Rel Ξ±)β¦ObjMapβ¦β¦aβ¦ = a"
if "a ββ©β dagcat_Rel Ξ±β¦DagCatβ¦β¦Objβ¦" for a
using that
unfolding dagcat_Rel_components cat_Rel_components(1)
by (cs_concl cs_simp: cat_cs_simps cat_Rel_cs_simps)
show "β β©C (dagcat_Rel Ξ±) β©Cβ©Fβ β β©C (dagcat_Rel Ξ±) = dghm_id (dagcat_Rel Ξ±β¦DagCatβ¦)"
unfolding dagcat_Rel_components
by (cs_concl cs_simp: cf_cn_comp_cf_dag_Rel_cf_dag_Rel)
qed (auto simp: dagcat_Rel_def)
subsectionβΉMonoidal categoryβΊ
textβΉ
For background information see Chapter 2 in \cite{etingof_tensor_2015}.
βΊ
subsubsectionβΉBackgroundβΊ
named_theorems mcat_field_simps
named_theorems mcat_cs_simps
named_theorems mcat_cs_intros
definition Mcat :: V where [mcat_field_simps]: "Mcat = 0"
definition Mcf :: V where [mcat_field_simps]: "Mcf = 1β©β"
definition Me :: V where [mcat_field_simps]: "Me = 2β©β"
definition MΞ± :: V where [mcat_field_simps]: "MΞ± = 3β©β"
definition Ml :: V where [mcat_field_simps]: "Ml = 4β©β"
definition Mr :: V where [mcat_field_simps]: "Mr = 5β©β"
subsubsectionβΉDefinition and elementary propertiesβΊ
locale monoidal_category =
π΅ Ξ± +
vfsequence β +
Mcat: category Ξ± βΉββ¦Mcatβ¦βΊ +
Mcf: is_functor Ξ± βΉ(ββ¦Mcatβ¦) Γβ©C (ββ¦Mcatβ¦)βΊ βΉββ¦Mcatβ¦βΊ βΉββ¦Mcfβ¦βΊ +
MΞ±: is_iso_ntcf
Ξ± βΉββ¦Mcatβ¦^β©Cβ©3βΊ βΉββ¦Mcatβ¦βΊ βΉcf_blcomp (ββ¦Mcfβ¦)βΊ βΉcf_brcomp (ββ¦Mcfβ¦)βΊ βΉββ¦MΞ±β¦βΊ +
Ml: is_iso_ntcf
Ξ±
βΉββ¦Mcatβ¦βΊ
βΉββ¦Mcatβ¦βΊ
βΉββ¦Mcfβ¦βββ¦Mcatβ¦,ββ¦Mcatβ¦β(ββ¦Meβ¦,-)β©Cβ©FβΊ
βΉcf_id (ββ¦Mcatβ¦)βΊ
βΉββ¦Mlβ¦βΊ +
Mr: is_iso_ntcf
Ξ±
βΉββ¦Mcatβ¦βΊ
βΉββ¦Mcatβ¦βΊ
βΉββ¦Mcfβ¦βββ¦Mcatβ¦,ββ¦Mcatβ¦β(-,ββ¦Meβ¦)β©Cβ©FβΊ
βΉcf_id (ββ¦Mcatβ¦)βΊ
βΉββ¦Mrβ¦βΊ
for Ξ± β +
assumes mcat_length[mcat_cs_simps]: "vcard β = 6β©β"
and mcat_Me_is_obj[mcat_cs_intros]: "ββ¦Meβ¦ ββ©β ββ¦Mcatβ¦β¦Objβ¦"
and mcat_pentagon:
"β¦
a ββ©β ββ¦Mcatβ¦β¦Objβ¦;
b ββ©β ββ¦Mcatβ¦β¦Objβ¦;
c ββ©β ββ¦Mcatβ¦β¦Objβ¦;
d ββ©β ββ¦Mcatβ¦β¦Objβ¦
β§ βΉ
(ββ¦Mcatβ¦β¦CIdβ¦β¦aβ¦ ββ©Hβ©Mβ©.β©Aβββ¦Mcfβ¦β ββ¦MΞ±β¦β¦NTMapβ¦β¦b, c, dβ¦β©β) ββ©Aβββ¦Mcatβ¦β
ββ¦MΞ±β¦β¦NTMapβ¦β¦a, b ββ©Hβ©Mβ©.β©Oβββ¦Mcfβ¦β c, dβ¦β©β ββ©Aβββ¦Mcatβ¦β
(ββ¦MΞ±β¦β¦NTMapβ¦β¦a, b, cβ¦β©β ββ©Hβ©Mβ©.β©Aβββ¦Mcfβ¦β ββ¦Mcatβ¦β¦CIdβ¦β¦dβ¦) =
ββ¦MΞ±β¦β¦NTMapβ¦β¦a, b, c ββ©Hβ©Mβ©.β©Oβββ¦Mcfβ¦β dβ¦β©β ββ©Aβββ¦Mcatβ¦β
ββ¦MΞ±β¦β¦NTMapβ¦β¦a ββ©Hβ©Mβ©.β©Oβββ¦Mcfβ¦β b, c, dβ¦β©β"
and mcat_triangle[mcat_cs_simps]:
"β¦ a ββ©β ββ¦Mcatβ¦β¦Objβ¦; b ββ©β ββ¦Mcatβ¦β¦Objβ¦ β§ βΉ
(ββ¦Mcatβ¦β¦CIdβ¦β¦aβ¦ ββ©Hβ©Mβ©.β©Aβββ¦Mcfβ¦β ββ¦Mlβ¦β¦NTMapβ¦β¦bβ¦) ββ©Aβββ¦Mcatβ¦β
ββ¦MΞ±β¦β¦NTMapβ¦β¦a, ββ¦Meβ¦, bβ¦β©β =
(ββ¦Mrβ¦β¦NTMapβ¦β¦aβ¦ ββ©Hβ©Mβ©.β©Aβββ¦Mcfβ¦β ββ¦Mcatβ¦β¦CIdβ¦β¦bβ¦)"
lemmas [mcat_cs_intros] = monoidal_category.mcat_Me_is_obj
lemmas [mcat_cs_simps] = monoidal_category.mcat_triangle
textβΉRules.βΊ
lemma (in monoidal_category) monoidal_category_axioms'[cat_cs_intros]:
assumes "Ξ±' = Ξ±"
shows "monoidal_category Ξ±' β"
unfolding assms by (rule monoidal_category_axioms)
mk_ide rf monoidal_category_def[unfolded monoidal_category_axioms_def]
|intro monoidal_categoryI|
|dest monoidal_categoryD[dest]|
|elim monoidal_categoryE[elim]|
textβΉElementary properties.βΊ
lemma mcat_eqI:
assumes "monoidal_category Ξ± π"
and "monoidal_category Ξ± π
"
and "πβ¦Mcatβ¦ = π
β¦Mcatβ¦"
and "πβ¦Mcfβ¦ = π
β¦Mcfβ¦"
and "πβ¦Meβ¦ = π
β¦Meβ¦"
and "πβ¦MΞ±β¦ = π
β¦MΞ±β¦"
and "πβ¦Mlβ¦ = π
β¦Mlβ¦"
and "πβ¦Mrβ¦ = π
β¦Mrβ¦"
shows "π = π
"
proof-
interpret π: monoidal_category Ξ± π by (rule assms(1))
interpret π
: monoidal_category Ξ± π
by (rule assms(2))
show ?thesis
proof(rule vsv_eqI)
have dom: "πβ©β π = 6β©β" by (cs_concl cs_simp: mcat_cs_simps V_cs_simps)
show "πβ©β π = πβ©β π
" by (cs_concl cs_simp: mcat_cs_simps V_cs_simps)
show "a ββ©β πβ©β π βΉ πβ¦aβ¦ = π
β¦aβ¦" for a
by (unfold dom, elim_in_numeral, insert assms)
(auto simp: mcat_field_simps)
qed auto
qed
subsectionβΉComponents for βΉMΞ±βΊ for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition MΞ±_Rel_arrow_lr :: "V β V β V β V"
where "MΞ±_Rel_arrow_lr A B C =
[
(Ξ»ab_cββ©β(A Γβ©β B) Γβ©β C. β¨vfst (vfst ab_c), β¨vsnd (vfst ab_c), vsnd ab_cβ©β©),
(A Γβ©β B) Γβ©β C,
A Γβ©β (B Γβ©β C)
]β©β"
definition MΞ±_Rel_arrow_rl :: "V β V β V β V"
where "MΞ±_Rel_arrow_rl A B C =
[
(Ξ»a_bcββ©βA Γβ©β (B Γβ©β C). β¨β¨vfst a_bc, vfst (vsnd a_bc)β©, vsnd (vsnd a_bc)β©),
A Γβ©β (B Γβ©β C),
(A Γβ©β B) Γβ©β C
]β©β"
textβΉComponents.βΊ
lemma MΞ±_Rel_arrow_lr_components:
shows "MΞ±_Rel_arrow_lr A B Cβ¦ArrValβ¦ =
(Ξ»ab_cββ©β(A Γβ©β B) Γβ©β C. β¨vfst (vfst ab_c), β¨vsnd (vfst ab_c), vsnd ab_cβ©β©)"
and [cat_cs_simps]: "MΞ±_Rel_arrow_lr A B Cβ¦ArrDomβ¦ = (A Γβ©β B) Γβ©β C"
and [cat_cs_simps]: "MΞ±_Rel_arrow_lr A B Cβ¦ArrCodβ¦ = A Γβ©β (B Γβ©β C)"
unfolding MΞ±_Rel_arrow_lr_def arr_field_simps by (simp_all add: nat_omega_simps)
lemma MΞ±_Rel_arrow_rl_components:
shows "MΞ±_Rel_arrow_rl A B Cβ¦ArrValβ¦ =
(Ξ»a_bcββ©βA Γβ©β (B Γβ©β C). β¨β¨vfst a_bc, vfst (vsnd a_bc)β©, vsnd (vsnd a_bc)β©)"
and [cat_cs_simps]: "MΞ±_Rel_arrow_rl A B Cβ¦ArrDomβ¦ = A Γβ©β (B Γβ©β C)"
and [cat_cs_simps]: "MΞ±_Rel_arrow_rl A B Cβ¦ArrCodβ¦ = (A Γβ©β B) Γβ©β C"
unfolding MΞ±_Rel_arrow_rl_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉArrow valueβΊ
mk_VLambda MΞ±_Rel_arrow_lr_components(1)
|vsv MΞ±_Rel_arrow_lr_ArrVal_vsv[cat_cs_intros]|
|vdomain MΞ±_Rel_arrow_lr_ArrVal_vdomain[cat_cs_simps]|
|app MΞ±_Rel_arrow_lr_ArrVal_app'|
lemma MΞ±_Rel_arrow_lr_ArrVal_app[cat_cs_simps]:
assumes "ab_c = β¨β¨a, bβ©, cβ©" and "ab_c ββ©β (A Γβ©β B) Γβ©β C"
shows "MΞ±_Rel_arrow_lr A B Cβ¦ArrValβ¦β¦ab_cβ¦ = β¨a, β¨b, cβ©β©"
using assms(2)
unfolding assms(1)
by (simp_all add: MΞ±_Rel_arrow_lr_ArrVal_app' nat_omega_simps)
mk_VLambda MΞ±_Rel_arrow_rl_components(1)
|vsv MΞ±_Rel_arrow_rl_ArrVal_vsv[cat_cs_intros]|
|vdomain MΞ±_Rel_arrow_rl_ArrVal_vdomain[cat_cs_simps]|
|app MΞ±_Rel_arrow_rl_ArrVal_app'|
lemma MΞ±_Rel_arrow_rl_ArrVal_app[cat_cs_simps]:
assumes "a_bc = β¨a, β¨b, cβ©β©" and "a_bc ββ©β A Γβ©β (B Γβ©β C)"
shows "MΞ±_Rel_arrow_rl A B Cβ¦ArrValβ¦β¦a_bcβ¦ = β¨β¨a, bβ©, cβ©"
using assms(2)
unfolding assms(1)
by (simp_all add: MΞ±_Rel_arrow_rl_ArrVal_app' nat_omega_simps)
subsubsectionβΉComponents for βΉMΞ±βΊ for βΉRelβΊ are arrowsβΊ
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±" and "C ββ©β Vset Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦βcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (MΞ±_Rel_arrow_lr A B C)" unfolding MΞ±_Rel_arrow_lr_def by auto
show "vcard (MΞ±_Rel_arrow_lr A B C) = 3β©β"
unfolding MΞ±_Rel_arrow_lr_def by (simp add: nat_omega_simps)
show "ββ©β (MΞ±_Rel_arrow_lr A B Cβ¦ArrValβ¦) ββ©β MΞ±_Rel_arrow_lr A B Cβ¦ArrCodβ¦"
unfolding MΞ±_Rel_arrow_lr_components by auto
qed
(
use assms in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_introsβΊ
)+
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±" and "C ββ©β Vset Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦βcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
proof(intro cat_Set_is_arrI arr_SetI)
show "vfsequence (MΞ±_Rel_arrow_rl A B C)" unfolding MΞ±_Rel_arrow_rl_def by auto
show "vcard (MΞ±_Rel_arrow_rl A B C) = 3β©β"
unfolding MΞ±_Rel_arrow_rl_def by (simp add: nat_omega_simps)
show "ββ©β (MΞ±_Rel_arrow_rl A B Cβ¦ArrValβ¦) ββ©β MΞ±_Rel_arrow_rl A B Cβ¦ArrCodβ¦"
unfolding MΞ±_Rel_arrow_rl_components by auto
qed
(
use assms in
βΉcs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_introsβΊ
)+
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Set_arr:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦βcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
using assms
unfolding cat_Set_components
by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset)
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Set Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr)
lemmas [cat_rel_par_Set_cs_intros] = π΅.MΞ±_Rel_arrow_lr_is_cat_Set_arr'
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Set_arr:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦βcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
using assms
unfolding cat_Set_components
by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset)
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Set_arr'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Set Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr)
lemmas [cat_rel_par_Set_cs_intros] = π΅.MΞ±_Rel_arrow_rl_is_cat_Set_arr'
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Par_arr:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦βcat_Par Ξ±β A Γβ©β (B Γβ©β C)"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
from assms show ?thesis
unfolding cat_Par_components(1)
by (intro Set_Par.subcat_is_arrD MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Par Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Par_arr)
lemmas [cat_rel_Par_set_cs_intros] = π΅.MΞ±_Rel_arrow_lr_is_cat_Par_arr'
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Par_arr:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦βcat_Par Ξ±β (A Γβ©β B) Γβ©β C"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
from assms show ?thesis
unfolding cat_Par_components(1)
by (intro Set_Par.subcat_is_arrD MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Par_arr'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Par Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Par_arr)
lemmas [cat_rel_Par_set_cs_intros] = π΅.MΞ±_Rel_arrow_rl_is_cat_Par_arr'
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Rel_arr:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦βcat_Rel Ξ±β A Γβ©β (B Γβ©β C)"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule subcat_trans[
OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
]
)
from assms show ?thesis
unfolding cat_Rel_components(1)
by (intro Set_Rel.subcat_is_arrD MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) MΞ±_Rel_arrow_lr_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Rel Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_lr_is_cat_Rel_arr)
lemmas [cat_Rel_par_set_cs_intros] = π΅.MΞ±_Rel_arrow_lr_is_cat_Rel_arr'
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Rel_arr:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦βcat_Rel Ξ±β (A Γβ©β B) Γβ©β C"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule subcat_trans[
OF Set_Par.subcategory_axioms Par_Rel.subcategory_axioms
]
)
from assms show ?thesis
unfolding cat_Rel_components(1)
by (intro Set_Rel.subcat_is_arrD MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset) auto
qed
lemma (in π΅) MΞ±_Rel_arrow_rl_is_cat_Rel_arr'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Rel Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦ββ'β B'"
using assms(1-3) unfolding assms(4-6) by (rule MΞ±_Rel_arrow_rl_is_cat_Rel_arr)
lemmas [cat_Rel_par_set_cs_intros] = π΅.MΞ±_Rel_arrow_rl_is_cat_Rel_arr'
subsubsectionβΉFurther propertiesβΊ
lemma (in π΅) MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr[cat_cs_simps]:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±" and "C ββ©β Vset Ξ±"
shows
"MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C =
cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (cs_concl cs_intro: cat_cs_intros)
from assms have lhs:
"MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C :
(A Γβ©β B) Γβ©β C β¦βcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
by
(
cs_concl
cs_simp: cat_Set_components(1)
cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
)
then have dom_lhs:
"πβ©β ((MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C)β¦ArrValβ¦) =
(A Γβ©β B) Γβ©β C"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms Set.category_axioms have rhs:
"cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦ :
(A Γβ©β B) Γβ©β C β¦βcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
by
(
cs_concl
cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β ((cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦)β¦ArrValβ¦) = (A Γβ©β B) Γβ©β C"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs:
"arr_Set Ξ± (MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs: "arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦)"
by (auto dest: cat_Set_is_arrD(1))
show
"(MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C)β¦ArrValβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix ab_c assume prems: "ab_c ββ©β (A Γβ©β B) Γβ©β C"
then obtain a b c
where ab_c_def: "ab_c = β¨β¨a, bβ©, cβ©"
and a: "a ββ©β A"
and b: "b ββ©β B"
and c: "c ββ©β C"
by clarsimp
from assms prems a b c lhs rhs show
"(MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C)β¦ArrValβ¦β¦ab_cβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦β¦ArrValβ¦β¦ab_cβ¦"
unfolding ab_c_def
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps
cs_intro: cat_rel_par_Set_cs_intros V_cs_intros cat_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemma (in π΅) MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr'[cat_cs_simps]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
shows
"MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C =
cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦"
using assms unfolding cat_Set_components(1) by (rule MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr)
lemmas [cat_cs_simps] = π΅.MΞ±_Rel_arrow_rl_MΞ±_Rel_arrow_lr'
lemma (in π΅) MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl[cat_cs_simps]:
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±" and "C ββ©β Vset Ξ±"
shows
"MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C =
cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (cs_concl cs_intro: cat_cs_intros)
from assms have lhs:
"MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C :
A Γβ©β (B Γβ©β C) β¦βcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
by
(
cs_concl
cs_simp: cat_Set_components(1)
cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros
)
then have dom_lhs:
"πβ©β ((MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C)β¦ArrValβ¦) =
A Γβ©β (B Γβ©β C)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms Set.category_axioms have rhs:
"cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦ :
A Γβ©β (B Γβ©β C) β¦βcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
by
(
cs_concl
cs_simp: cat_Set_components(1) cs_intro: V_cs_intros cat_cs_intros
)
then have dom_rhs:
"πβ©β ((cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦)β¦ArrValβ¦) = A Γβ©β (B Γβ©β C)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs:
"arr_Set Ξ± (MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs: "arr_Set Ξ± (cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦)"
by (auto dest: cat_Set_is_arrD(1))
show
"(MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C)β¦ArrValβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a_bc assume prems: "a_bc ββ©β A Γβ©β (B Γβ©β C)"
then obtain a b c
where a_bc_def: "a_bc = β¨a, β¨b, cβ©β©"
and a: "a ββ©β A"
and b: "b ββ©β B"
and c: "c ββ©β C"
by clarsimp
from assms prems a b c lhs rhs show
"(MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C)β¦ArrValβ¦β¦a_bcβ¦ =
cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦β¦ArrValβ¦β¦a_bcβ¦"
unfolding a_bc_def
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps
cs_intro: V_cs_intros cat_rel_par_Set_cs_intros cat_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
lemma (in π΅) MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl'[cat_cs_simps]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
shows
"MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C =
cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β (B Γβ©β C)β¦"
using assms
unfolding cat_Set_components(1)
by (rule MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl)
lemmas [cat_cs_simps] = π΅.MΞ±_Rel_arrow_lr_MΞ±_Rel_arrow_rl'
subsubsectionβΉComponents for βΉMΞ±βΊ for βΉRelβΊ are isomorphismsβΊ
lemma (in π΅)
assumes "A ββ©β Vset Ξ±" and "B ββ©β Vset Ξ±" and "C ββ©β Vset Ξ±"
shows MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset:
"MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
and MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset:
"MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
proof-
interpret Set: category Ξ± βΉcat_Set Ξ±βΊ by (cs_concl cs_intro: cat_cs_intros)
have lhs: "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦βcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
by (intro MΞ±_Rel_arrow_rl_is_cat_Set_arr_Vset assms)
from assms have [cat_cs_simps]:
"MΞ±_Rel_arrow_rl A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_lr A B C =
cat_Set Ξ±β¦CIdβ¦β¦(A Γβ©β B) Γβ©β Cβ¦"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
)
from assms have [cat_cs_simps]:
"MΞ±_Rel_arrow_lr A B C ββ©Aβcat_Set Ξ±β MΞ±_Rel_arrow_rl A B C =
cat_Set Ξ±β¦CIdβ¦β¦A Γβ©β B Γβ©β Cβ¦"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cs_intro: cat_cs_intros
)
from
Set.is_arr_isomorphismI'
[
OF lhs MΞ±_Rel_arrow_lr_is_cat_Set_arr_Vset[OF assms],
unfolded cat_cs_simps,
simplified
]
show "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
and "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
by auto
qed
lemma (in π΅)
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
shows MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism:
"MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Set Ξ±β A Γβ©β (B Γβ©β C)"
and MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism:
"MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Set Ξ±β (A Γβ©β B) Γβ©β C"
using assms
unfolding cat_Set_components(1)
by
(
all
βΉ
intro
MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset
MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset
βΊ
)
lemma (in π΅)
MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Set Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism)
lemmas [cat_rel_par_Set_cs_intros] =
π΅.MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism'
lemma (in π΅)
MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism'[cat_rel_par_Set_cs_intros]:
assumes "A ββ©β cat_Set Ξ±β¦Objβ¦"
and "B ββ©β cat_Set Ξ±β¦Objβ¦"
and "C ββ©β cat_Set Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Set Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism)
lemmas [cat_rel_par_Set_cs_intros] =
π΅.MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism'
lemma (in π΅)
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
shows MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism:
"MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Par Ξ±β A Γβ©β (B Γβ©β C)"
and MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism:
"MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Par Ξ±β (A Γβ©β B) Γβ©β C"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
show "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Par Ξ±β A Γβ©β (B Γβ©β C)"
by
(
rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Par_components]
]
]
)
show "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Par Ξ±β (A Γβ©β B) Γβ©β C"
by
(
rule Set_Par.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Par_components]
]
]
)
qed
lemma (in π΅)
MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Par Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism)
lemmas [cat_rel_Par_set_cs_intros] =
π΅.MΞ±_Rel_arrow_lr_is_cat_Par_arr_isomorphism'
lemma (in π΅)
MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism'[cat_rel_Par_set_cs_intros]:
assumes "A ββ©β cat_Par Ξ±β¦Objβ¦"
and "B ββ©β cat_Par Ξ±β¦Objβ¦"
and "C ββ©β cat_Par Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Par Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism)
lemmas [cat_rel_Par_set_cs_intros] =
π΅.MΞ±_Rel_arrow_rl_is_cat_Par_arr_isomorphism'
lemma (in π΅)
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
shows MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism:
"MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Rel Ξ±β A Γβ©β (B Γβ©β C)"
and MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism:
"MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Rel Ξ±β (A Γβ©β B) Γβ©β C"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule wr_subcat_trans
[
OF
Set_Par.wide_replete_subcategory_axioms
Par_Rel.wide_replete_subcategory_axioms
]
)
show "MΞ±_Rel_arrow_lr A B C : (A Γβ©β B) Γβ©β C β¦β©iβ©sβ©oβcat_Rel Ξ±β A Γβ©β (B Γβ©β C)"
by
(
rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF MΞ±_Rel_arrow_lr_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Rel_components]
]
]
)
show "MΞ±_Rel_arrow_rl A B C : A Γβ©β (B Γβ©β C) β¦β©iβ©sβ©oβcat_Rel Ξ±β (A Γβ©β B) Γβ©β C"
by
(
rule Set_Rel.wr_subcat_is_arr_isomorphism_is_arr_isomorphism
[
THEN iffD1,
OF MΞ±_Rel_arrow_rl_is_cat_Set_arr_isomorphism_Vset[
OF assms[unfolded cat_Rel_components]
]
]
)
qed
lemma (in π΅)
MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
and "A' = (A Γβ©β B) Γβ©β C"
and "B' = A Γβ©β (B Γβ©β C)"
and "β' = cat_Rel Ξ±"
shows "MΞ±_Rel_arrow_lr A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism)
lemmas [cat_Rel_par_set_cs_intros] =
π΅.MΞ±_Rel_arrow_lr_is_cat_Rel_arr_isomorphism'
lemma (in π΅)
MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'[cat_Rel_par_set_cs_intros]:
assumes "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and "C ββ©β cat_Rel Ξ±β¦Objβ¦"
and "A' = A Γβ©β (B Γβ©β C)"
and "B' = (A Γβ©β B) Γβ©β C"
and "β' = cat_Rel Ξ±"
shows "MΞ±_Rel_arrow_rl A B C : A' β¦β©iβ©sβ©oββ'β B'"
using assms(1-3)
unfolding assms(4-6)
by (rule MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism)
lemmas [cat_Rel_par_set_cs_intros] =
π΅.MΞ±_Rel_arrow_rl_is_cat_Rel_arr_isomorphism'
subsectionβΉβΉMΞ±βΊ for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition MΞ±_Rel :: "V β V"
where "MΞ±_Rel β =
[
(Ξ»abcββ©β(β^β©Cβ©3)β¦Objβ¦. MΞ±_Rel_arrow_lr (abcβ¦0β¦) (abcβ¦1β©ββ¦) (abcβ¦2β©ββ¦)),
cf_blcomp (cf_prod_2_Rel β),
cf_brcomp (cf_prod_2_Rel β),
β^β©Cβ©3,
β
]β©β"
textβΉComponents.βΊ
lemma MΞ±_Rel_components:
shows "MΞ±_Rel ββ¦NTMapβ¦ =
(Ξ»abcββ©β(β^β©Cβ©3)β¦Objβ¦. MΞ±_Rel_arrow_lr (abcβ¦0β¦) (abcβ¦1β©ββ¦) (abcβ¦2β©ββ¦))"
and [cat_cs_simps]: "MΞ±_Rel ββ¦NTDomβ¦ = cf_blcomp (cf_prod_2_Rel β)"
and [cat_cs_simps]: "MΞ±_Rel ββ¦NTCodβ¦ = cf_brcomp (cf_prod_2_Rel β)"
and [cat_cs_simps]: "MΞ±_Rel ββ¦NTDGDomβ¦ = β^β©Cβ©3"
and [cat_cs_simps]: "MΞ±_Rel ββ¦NTDGCodβ¦ = β"
unfolding MΞ±_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda MΞ±_Rel_components(1)
|vsv MΞ±_Rel_NTMap_vsv[cat_cs_intros]|
|vdomain MΞ±_Rel_NTMap_vdomain[cat_cs_simps]|
|app MΞ±_Rel_NTMap_app'|
lemma MΞ±_Rel_NTMap_app[cat_cs_simps]:
assumes "ABC = [A, B, C]β©β" and "ABC ββ©β (β^β©Cβ©3)β¦Objβ¦"
shows "MΞ±_Rel ββ¦NTMapβ¦β¦ABCβ¦ = MΞ±_Rel_arrow_lr A B C"
using assms(2)
unfolding assms(1)
by (simp add: MΞ±_Rel_NTMap_app' nat_omega_simps)
subsubsectionβΉβΉMΞ±βΊ for βΉRelβΊ is a natural isomorphismβΊ
lemma (in π΅) MΞ±_Rel_is_iso_ntcf:
"MΞ±_Rel (cat_Rel Ξ±) :
cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±)) β¦β©Cβ©Fβ©.β©iβ©sβ©o
cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±)) :
cat_Rel Ξ±^β©Cβ©3 β¦β¦β©CβΞ±β cat_Rel Ξ±"
proof-
interpret cf_prod: is_functor
Ξ± βΉcat_Rel Ξ± Γβ©C cat_Rel Ξ±βΊ βΉcat_Rel Ξ±βΊ βΉcf_prod_2_Rel (cat_Rel Ξ±)βΊ
by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence (MΞ±_Rel (cat_Rel Ξ±))" unfolding MΞ±_Rel_def by auto
show "vcard (MΞ±_Rel (cat_Rel Ξ±)) = 5β©β"
unfolding MΞ±_Rel_def by (simp add: nat_omega_simps)
show "MΞ±_Rel (cat_Rel Ξ±)β¦NTMapβ¦β¦ABCβ¦ :
cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ObjMapβ¦β¦ABCβ¦ β¦β©iβ©sβ©oβcat_Rel Ξ±β
cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ObjMapβ¦β¦ABCβ¦"
if "ABC ββ©β (cat_Rel Ξ±^β©Cβ©3)β¦Objβ¦" for ABC
proof-
from that category_cat_Rel obtain A B C
where ABC_def: "ABC = [A, B, C]β©β"
and A: "A ββ©β cat_Rel Ξ±β¦Objβ¦"
and B: "B ββ©β cat_Rel Ξ±β¦Objβ¦"
and C: "C ββ©β cat_Rel Ξ±β¦Objβ¦"
by (elim cat_prod_3_ObjE[rotated 3])
from that A B C show ?thesis
unfolding ABC_def
by
(
cs_concl
cs_intro:
cat_cs_intros cat_Rel_par_set_cs_intros cat_prod_cs_intros
cs_simp: cat_cs_simps cat_Rel_cs_simps
)
qed
then show "MΞ±_Rel (cat_Rel Ξ±)β¦NTMapβ¦β¦ABCβ¦ :
cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ObjMapβ¦β¦ABCβ¦ β¦βcat_Rel Ξ±β
cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ObjMapβ¦β¦ABCβ¦"
if "ABC ββ©β (cat_Rel Ξ±^β©Cβ©3)β¦Objβ¦" for ABC
using that by (simp add: cat_Rel_is_arr_isomorphismD(1))
show
"MΞ±_Rel (cat_Rel Ξ±)β¦NTMapβ¦β¦ABC'β¦ ββ©Aβcat_Rel Ξ±β
cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ArrMapβ¦β¦HGFβ¦ =
cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))β¦ArrMapβ¦β¦HGFβ¦ ββ©Aβcat_Rel Ξ±β
MΞ±_Rel (cat_Rel Ξ±)β¦NTMapβ¦β¦ABCβ¦"
if "HGF : ABC β¦βcat_Rel Ξ±^β©Cβ©3β ABC'" for ABC ABC' HGF
proof-
from that obtain H G F A B C A' B' C'
where HGF_def: "HGF = [H, G, F]β©β"
and ABC_def: "ABC = [A, B, C]β©β"
and ABC'_def: "ABC' = [A', B', C']β©β"
and H_is_arr: "H : A β¦βcat_Rel Ξ±β A'"
and G_is_arr: "G : B β¦βcat_Rel Ξ±β B'"
and F_is_arr: "F : C β¦βcat_Rel Ξ±β C'"
by
(
elim cat_prod_3_is_arrE[
OF category_cat_Rel category_cat_Rel category_cat_Rel
]
)
note H = cat_Rel_is_arrD[OF H_is_arr]
note G = cat_Rel_is_arrD[OF G_is_arr]
note F = cat_Rel_is_arrD[OF F_is_arr]
interpret H: arr_Rel Ξ± H
rewrites "Hβ¦ArrDomβ¦ = A" and "Hβ¦ArrCodβ¦ = A'"
by (intro H)+
interpret G: arr_Rel Ξ± G
rewrites "Gβ¦ArrDomβ¦ = B" and "Gβ¦ArrCodβ¦ = B'"
by (intro G)+
interpret F: arr_Rel Ξ± F
rewrites "Fβ¦ArrDomβ¦ = C" and "Fβ¦ArrCodβ¦ = C'"
by (intro F)+
let ?ABC' = βΉMΞ±_Rel_arrow_lr A' B' C'βΊ
and ?ABC = βΉMΞ±_Rel_arrow_lr A B CβΊ
and ?HG_F =
βΉ
prod_2_Rel_ArrVal
(prod_2_Rel_ArrVal (Hβ¦ArrValβ¦) (Gβ¦ArrValβ¦))
(Fβ¦ArrValβ¦)
βΊ
and ?H_GF =
βΉ
prod_2_Rel_ArrVal
(Hβ¦ArrValβ¦)
(prod_2_Rel_ArrVal (Gβ¦ArrValβ¦) (Fβ¦ArrValβ¦))
βΊ
have [cat_cs_simps]:
"?ABC' ββ©Aβcat_Rel Ξ±β prod_2_Rel (prod_2_Rel H G) F =
prod_2_Rel H (prod_2_Rel G F) ββ©Aβcat_Rel Ξ±β ?ABC"
proof-
from H_is_arr G_is_arr F_is_arr have lhs:
"?ABC' ββ©Aβcat_Rel Ξ±β prod_2_Rel (prod_2_Rel H G) F :
(A Γβ©β B) Γβ©β C β¦βcat_Rel Ξ±β A' Γβ©β (B' Γβ©β C')"
by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
from H_is_arr G_is_arr F_is_arr have rhs:
"prod_2_Rel H (prod_2_Rel G F) ββ©Aβcat_Rel Ξ±β ?ABC :
(A Γβ©β B) Γβ©β C β¦βcat_Rel Ξ±β A' Γβ©β (B' Γβ©β C')"
by (cs_concl cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros)
show ?thesis
proof(rule arr_Rel_eqI)
from lhs show arr_Rel_lhs:
"arr_Rel Ξ± (?ABC' ββ©Aβcat_Rel Ξ±β prod_2_Rel (prod_2_Rel H G) F)"
by (auto dest: cat_Rel_is_arrD)
from rhs show arr_Rel_rhs:
"arr_Rel Ξ± (prod_2_Rel H (prod_2_Rel G F) ββ©Aβcat_Rel Ξ±β ?ABC)"
by (auto dest: cat_Rel_is_arrD)
have [cat_cs_simps]: "?ABC'β¦ArrValβ¦ ββ©β ?HG_F = ?H_GF ββ©β ?ABCβ¦ArrValβ¦"
proof(intro vsubset_antisym vsubsetI)
fix abc_abc'' assume prems: "abc_abc'' ββ©β ?ABC'β¦ArrValβ¦ ββ©β ?HG_F"
then obtain abc abc' abc''
where abc_abc''_def: "abc_abc'' = β¨abc, abc''β©"
and abc_abc': "β¨abc, abc'β© ββ©β ?HG_F"
and abc'_abc'': "β¨abc', abc''β© ββ©β ?ABC'β¦ArrValβ¦"
by clarsimp
from abc_abc' obtain ab c ab' c'
where abc_abc'_def: "β¨abc, abc'β© = β¨β¨ab, cβ©, β¨ab', c'β©β©"
and ab_ab':
"β¨ab, ab'β© ββ©β prod_2_Rel_ArrVal (Hβ¦ArrValβ¦) (Gβ¦ArrValβ¦)"
and cc': "β¨c, c'β© ββ©β Fβ¦ArrValβ¦"
by auto
then have abc_def: "abc = β¨ab, cβ©" and abc'_def: "abc' = β¨ab', c'β©"
by auto
from ab_ab' obtain a b a' b'
where ab_ab'_def: "β¨ab, ab'β© = β¨β¨a, bβ©, β¨a', b'β©β©"
and aa': "β¨a, a'β© ββ©β Hβ¦ArrValβ¦"
and bb': "β¨b, b'β© ββ©β Gβ¦ArrValβ¦"
by auto
then have ab_def: "ab = β¨a, bβ©" and ab'_def: "ab' = β¨a', b'β©"
by auto
from cc' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange
have c: "c ββ©β C" and c': "c' ββ©β C'"
by auto
from bb' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange
have b: "b ββ©β B" and b': "b' ββ©β B'"
by auto
from aa' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange
have a: "a ββ©β A" and a': "a' ββ©β A'"
by auto
from abc'_abc'' have "abc'' = ?ABC'β¦ArrValβ¦β¦abc'β¦"
by (simp add: vsv.vsv_appI[OF MΞ±_Rel_arrow_lr_ArrVal_vsv])
also from a' b' c' have "β¦ = β¨a', β¨b', c'β©β©"
unfolding abc'_def ab'_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
finally have abc''_def: "abc'' = β¨a', β¨b', c'β©β©" by auto
from aa' bb' cc' a a' b b' c c' show
"abc_abc'' ββ©β ?H_GF ββ©β ?ABCβ¦ArrValβ¦"
unfolding abc_abc''_def abc_def abc'_def abc''_def ab'_def ab_def
by (intro vcompI prod_2_Rel_ArrValI)
(
cs_concl
cs_simp: cat_cs_simps
cs_intro:
vsv.vsv_ex1_app2[THEN iffD1]
V_cs_intros
cat_cs_intros
cat_Rel_cs_intros
)+
next
fix abc_abc'' assume prems: "abc_abc'' ββ©β ?H_GF ββ©β ?ABCβ¦ArrValβ¦"
then obtain abc abc' abc''
where abc_abc''_def: "abc_abc'' = β¨abc, abc''β©"
and abc_abc': "β¨abc, abc'β© ββ©β ?ABCβ¦ArrValβ¦"
and abc'_abc'': "β¨abc', abc''β© ββ©β ?H_GF"
by clarsimp
from abc'_abc'' obtain a' bc' a'' bc''
where abc'_abc''_def: "β¨abc', abc''β© = β¨β¨a', bc'β©, β¨a'', bc''β©β©"
and aa'': "β¨a', a''β© ββ©β Hβ¦ArrValβ¦"
and bc'_bc'':
"β¨bc', bc''β© ββ©β prod_2_Rel_ArrVal (Gβ¦ArrValβ¦) (Fβ¦ArrValβ¦)"
by auto
then have abc'_def: "abc' = β¨a', bc'β©"
and abc''_def: "abc'' = β¨a'', bc''β©"
by auto
from bc'_bc'' obtain b' c' b'' c''
where bc'_bc''_def: "β¨bc', bc''β© = β¨β¨b', c'β©, β¨b'', c''β©β©"
and bb'': "β¨b', b''β© ββ©β Gβ¦ArrValβ¦"
and cc'': "β¨c', c''β© ββ©β Fβ¦ArrValβ¦"
by auto
then have bc'_def: "bc' = β¨b', c'β©"
and bc''_def: "bc'' = β¨b'', c''β©"
by auto
from cc'' F.arr_Rel_ArrVal_vdomain F.arr_Rel_ArrVal_vrange
have c': "c' ββ©β C" and c'': "c'' ββ©β C'"
by auto
from bb'' G.arr_Rel_ArrVal_vdomain G.arr_Rel_ArrVal_vrange
have b': "b' ββ©β B" and b'': "b'' ββ©β B'"
by auto
from aa'' H.arr_Rel_ArrVal_vdomain H.arr_Rel_ArrVal_vrange
have a': "a' ββ©β A" and a'': "a'' ββ©β A'"
by auto
from abc_abc' have "abc ββ©β πβ©β (?ABCβ¦ArrValβ¦)" by auto
then have "abc ββ©β (A Γβ©β B) Γβ©β C" by (simp add: cat_cs_simps)
then obtain a b c
where abc_def: "abc = β¨β¨a, bβ©, cβ©"
and a: "a ββ©β A"
and b: "b ββ©β B"
and c: "c ββ©β C"
by auto
from abc_abc' have "abc' = ?ABCβ¦ArrValβ¦β¦abcβ¦"
by (simp add: vsv.vsv_appI[OF MΞ±_Rel_arrow_lr_ArrVal_vsv])
also from a b c have "β¦ = β¨a, β¨b, cβ©β©"
unfolding abc_def bc'_def
by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros)
finally have abc'_def': "abc' = β¨a, β¨b, cβ©β©" by auto
with abc'_def[unfolded bc'_def] have [cat_cs_simps]:
"a = a'" "b = b'" "c = c'"
by auto
from a'' b'' c'' have "β¨β¨a'', b''β©, c''β© ββ©β (A' Γβ©β B') Γβ©β C'"
by (cs_concl cs_intro: V_cs_intros)
with aa'' bb'' cc'' a a' b b' c c' show
"abc_abc'' ββ©β ?ABC'β¦ArrValβ¦ ββ©β ?HG_F"
unfolding abc_abc''_def abc_def abc'_def abc''_def bc''_def
by (intro vcompI prod_2_Rel_ArrValI)
(
cs_concl
cs_simp: cat_cs_simps
cs_intro:
vsv.vsv_ex1_app2[THEN iffD1]
V_cs_intros cat_cs_intros cat_Rel_cs_intros
)+
qed
from that H_is_arr G_is_arr F_is_arr show
"(?ABC' ββ©Aβcat_Rel Ξ±β prod_2_Rel (prod_2_Rel H G) F)β¦ArrValβ¦ =
(prod_2_Rel H (prod_2_Rel G F) ββ©Aβcat_Rel Ξ±β ?ABC)β¦ArrValβ¦"
by
(
cs_concl
cs_simp:
prod_2_Rel_components comp_Rel_components
cat_Rel_cs_simps cat_cs_simps
cs_intro:
cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from that H_is_arr G_is_arr F_is_arr show ?thesis
unfolding HGF_def ABC_def ABC'_def
by
(
cs_concl
cs_intro:
cat_Rel_par_set_cs_intros cat_cs_intros cat_prod_cs_intros
cs_simp: cat_Rel_cs_simps cat_cs_simps
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma (in π΅) MΞ±_Rel_is_iso_ntcf'[cat_cs_intros]:
assumes "π' = cf_blcomp (cf_prod_2_Rel (cat_Rel Ξ±))"
and "π' = cf_brcomp (cf_prod_2_Rel (cat_Rel Ξ±))"
and "π' = cat_Rel Ξ±^β©Cβ©3"
and "π
' = cat_Rel Ξ±"
and "Ξ±' = Ξ±"
shows "MΞ±_Rel (cat_Rel Ξ±) : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±'β π
'"
unfolding assms by (rule MΞ±_Rel_is_iso_ntcf)
lemmas [cat_cs_intros] = π΅.MΞ±_Rel_is_iso_ntcf'
subsectionβΉβΉMlβΊ and βΉMrβΊ for βΉRelβΊβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
definition Ml_Rel :: "V β V β V"
where "Ml_Rel β a =
[
(Ξ»Bββ©βββ¦Objβ¦. vsnd_arrow (set {a}) B),
cf_prod_2_Rel βββ,ββ(set {a},-)β©Cβ©F,
cf_id β,
β,
β
]β©β"
definition Mr_Rel :: "V β V β V"
where "Mr_Rel β b =
[
(Ξ»Aββ©βββ¦Objβ¦. vfst_arrow A (set {b})),
cf_prod_2_Rel βββ,ββ(-,set {b})β©Cβ©F,
cf_id β,
β,
β
]β©β"
textβΉComponents.βΊ
lemma Ml_Rel_components:
shows "Ml_Rel β aβ¦NTMapβ¦ = (Ξ»Bββ©βββ¦Objβ¦. vsnd_arrow (set {a}) B)"
and [cat_cs_simps]: "Ml_Rel β aβ¦NTDomβ¦ = cf_prod_2_Rel βββ,ββ(set {a},-)β©Cβ©F"
and [cat_cs_simps]: "Ml_Rel β aβ¦NTCodβ¦ = cf_id β"
and [cat_cs_simps]: "Ml_Rel β aβ¦NTDGDomβ¦ = β"
and [cat_cs_simps]: "Ml_Rel β aβ¦NTDGCodβ¦ = β"
unfolding Ml_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma Mr_Rel_components:
shows "Mr_Rel β bβ¦NTMapβ¦ = (Ξ»Aββ©βββ¦Objβ¦. vfst_arrow A (set {b}))"
and [cat_cs_simps]: "Mr_Rel β bβ¦NTDomβ¦ = cf_prod_2_Rel βββ,ββ(-,set {b})β©Cβ©F"
and [cat_cs_simps]: "Mr_Rel β bβ¦NTCodβ¦ = cf_id β"
and [cat_cs_simps]: "Mr_Rel β bβ¦NTDGDomβ¦ = β"
and [cat_cs_simps]: "Mr_Rel β bβ¦NTDGCodβ¦ = β"
unfolding Mr_Rel_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉNatural transformation mapβΊ
mk_VLambda Ml_Rel_components(1)
|vsv Ml_Rel_components_NTMap_vsv[cat_cs_intros]|
|vdomain Ml_Rel_components_NTMap_vdomain[cat_cs_simps]|
|app Ml_Rel_components_NTMap_app[cat_cs_simps]|
mk_VLambda Mr_Rel_components(1)
|vsv Mr_Rel_components_NTMap_vsv[cat_cs_intros]|
|vdomain Mr_Rel_components_NTMap_vdomain[cat_cs_simps]|
|app Mr_Rel_components_NTMap_app[cat_cs_simps]|
subsubsectionβΉβΉMlβΊ and βΉMrβΊ for βΉRelβΊ are natural isomorphismsβΊ
lemma (in π΅) Ml_Rel_is_iso_ntcf:
assumes "a ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "Ml_Rel (cat_Rel Ξ±) a:
cf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β(set {a},-)β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o
cf_id (cat_Rel Ξ±) :
cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
proof-
let ?cf_prod = βΉcf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β (set {a},-)β©Cβ©FβΊ
note [cat_cs_simps] = set_empty
interpret cf_prod: is_functor
Ξ± βΉcat_Rel Ξ± Γβ©C cat_Rel Ξ±βΊ βΉcat_Rel Ξ±βΊ βΉcf_prod_2_Rel (cat_Rel Ξ±)βΊ
by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence (Ml_Rel (cat_Rel Ξ±) a)" unfolding Ml_Rel_def by auto
show "vcard (Ml_Rel (cat_Rel Ξ±) a) = 5β©β"
unfolding Ml_Rel_def by (simp add: nat_omega_simps)
from assms show "?cf_prod : cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_cs_intros V_cs_intros
)
show "Ml_Rel (cat_Rel Ξ±) aβ¦NTMapβ¦β¦Bβ¦ :
?cf_prodβ¦ObjMapβ¦β¦Bβ¦ β¦β©iβ©sβ©oβcat_Rel Ξ±β cf_id (cat_Rel Ξ±)β¦ObjMapβ¦β¦Bβ¦"
if "B ββ©β cat_Rel Ξ±β¦Objβ¦" for B
using assms that
by
(
cs_concl
cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps
cs_intro:
cat_Rel_par_set_cs_intros
cat_cs_intros
V_cs_intros
cat_prod_cs_intros
)
with cat_Rel_is_arr_isomorphismD[OF this] show
"Ml_Rel (cat_Rel Ξ±) aβ¦NTMapβ¦β¦Bβ¦ :
?cf_prodβ¦ObjMapβ¦β¦Bβ¦ β¦βcat_Rel Ξ±β cf_id (cat_Rel Ξ±)β¦ObjMapβ¦β¦Bβ¦"
if "B ββ©β cat_Rel Ξ±β¦Objβ¦" for B
using that by simp
show
"Ml_Rel (cat_Rel Ξ±) aβ¦NTMapβ¦β¦Bβ¦ ββ©Aβcat_Rel Ξ±β ?cf_prodβ¦ArrMapβ¦β¦Fβ¦ =
cf_id (cat_Rel Ξ±)β¦ArrMapβ¦β¦Fβ¦ ββ©Aβcat_Rel Ξ±β Ml_Rel (cat_Rel Ξ±) aβ¦NTMapβ¦β¦Aβ¦"
if "F : A β¦βcat_Rel Ξ±β B" for A B F
proof-
note F = cat_Rel_is_arrD[OF that]
interpret F: arr_Rel Ξ± F
rewrites "Fβ¦ArrDomβ¦ = A" and "Fβ¦ArrCodβ¦ = B"
by (intro F)+
have [cat_cs_simps]:
"vsnd_arrow (set {a}) B ββ©Aβcat_Rel Ξ±β
prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦set {a}β¦) F =
F ββ©Aβcat_Rel Ξ±β vsnd_arrow (set {a}) A"
(is βΉ?B2 ββ©Aβcat_Rel Ξ±β ?aF = F ββ©Aβcat_Rel Ξ±β ?A2βΊ)
proof-
from assms that have lhs:
"?B2 ββ©Aβcat_Rel Ξ±β ?aF : set {a} Γβ©β A β¦βcat_Rel Ξ±β B"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
)
from assms that have rhs:
"F ββ©Aβcat_Rel Ξ±β ?A2 : set {a} Γβ©β A β¦βcat_Rel Ξ±β B"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_Rel_par_set_cs_intros cat_cs_intros V_cs_intros
)
have [cat_cs_simps]:
"?B2β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (vid_on (set {a})) (Fβ¦ArrValβ¦) =
Fβ¦ArrValβ¦ ββ©β ?A2β¦ArrValβ¦"
proof(intro vsubset_antisym vsubsetI)
fix xx'_z assume "xx'_z ββ©β
?B2β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (vid_on (set {a})) (Fβ¦ArrValβ¦)"
then obtain xx' yy' z
where xx'_z_def: "xx'_z = β¨xx', zβ©"
and xx'_yy':
"β¨xx', yy'β© ββ©β prod_2_Rel_ArrVal (vid_on (set {a})) (Fβ¦ArrValβ¦)"
and yy'_z: "β¨yy', zβ© ββ©β ?B2β¦ArrValβ¦"
by auto
from xx'_yy' obtain x x' y y'
where "β¨xx', yy'β© = β¨β¨x, x'β©, β¨y, y'β©β©"
and "β¨x, yβ© ββ©β vid_on (set {a})"
and xy': "β¨x', y'β© ββ©β Fβ¦ArrValβ¦"
by auto
then have xx'_def: "xx' = β¨a, x'β©" and yy'_def: "yy' = β¨a, y'β©"
by simp_all
with yy'_z have y': "y' ββ©β B" and z_def: "z = y'"
unfolding vsnd_arrow_components by auto
from xy' vsubsetD have x': "x' ββ©β A"
by (auto intro: F.arr_Rel_ArrVal_vdomain)
show "xx'_z ββ©β Fβ¦ArrValβ¦ ββ©β ?A2β¦ArrValβ¦"
unfolding xx'_z_def z_def xx'_def
by (intro vcompI, rule xy')
(auto simp: vsnd_arrow_components x' VLambda_iff2)
next
fix ay_z assume "ay_z ββ©β Fβ¦ArrValβ¦ ββ©β ?A2β¦ArrValβ¦"
then obtain ay y z
where xx'_z_def: "ay_z = β¨ay, zβ©"
and ay_y: "β¨ay, yβ© ββ©β ?A2β¦ArrValβ¦"
and yz[cat_cs_intros]: "β¨y, zβ© ββ©β Fβ¦ArrValβ¦"
by auto
then have ay_z_def: "ay_z = β¨β¨a, yβ©, zβ©"
and y: "y ββ©β A"
and ay_def: "ay = β¨a, yβ©"
unfolding vsnd_arrow_components by auto
from yz vsubsetD have z: "z ββ©β B"
by (auto intro: F.arr_Rel_ArrVal_vrange)
have [cat_cs_intros]: "β¨a, aβ© ββ©β vid_on (set {a})" by auto
show "ay_z ββ©β
?B2β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (vid_on (set {a})) (Fβ¦ArrValβ¦)"
unfolding ay_z_def
by
(
intro vcompI prod_2_Rel_ArrValI,
rule vsv.vsv_ex1_app1[THEN iffD1],
unfold cat_cs_simps,
insert z
)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
)
qed
show ?thesis
proof(rule arr_Rel_eqI)
from lhs show arr_Rel_lhs: "arr_Rel Ξ± (?B2 ββ©Aβcat_Rel Ξ±β ?aF)"
by (auto dest: cat_Rel_is_arrD)
from rhs show "arr_Rel Ξ± (F ββ©Aβcat_Rel Ξ±β ?A2)"
by (auto dest: cat_Rel_is_arrD)
note cat_Rel_CId_app[cat_Rel_cs_simps del]
note π΅.cat_Rel_CId_app[cat_Rel_cs_simps del]
from that assms show
"(?B2 ββ©Aβcat_Rel Ξ±β ?aF)β¦ArrValβ¦ = (F ββ©Aβcat_Rel Ξ±β ?A2)β¦ArrValβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
cs_simp:
id_Rel_components
cat_Rel_CId_app
comp_Rel_components(1)
prod_2_Rel_components
cat_Rel_components(1)
)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from that assms show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
cs_simp: cat_Rel_components(1) V_cs_simps
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma (in π΅) Ml_Rel_is_iso_ntcf'[cat_cs_intros]:
assumes "a ββ©β cat_Rel Ξ±β¦Objβ¦"
and "π' = cf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β(set {a},-)β©Cβ©F"
and "π' = cf_id (cat_Rel Ξ±)"
and "π' = cat_Rel Ξ±"
and "π
' = cat_Rel Ξ±"
and "Ξ±' = Ξ±"
shows "Ml_Rel (cat_Rel Ξ±) a : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±β π
'"
using assms(1) unfolding assms(2-6) by (rule Ml_Rel_is_iso_ntcf)
lemmas [cat_cs_intros] = π΅.Ml_Rel_is_iso_ntcf'
lemma (in π΅) Mr_Rel_is_iso_ntcf:
assumes "b ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "Mr_Rel (cat_Rel Ξ±) b :
cf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β(-,set {b})β©Cβ©F β¦β©Cβ©Fβ©.β©iβ©sβ©o
cf_id (cat_Rel Ξ±) :
cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
proof-
let ?cf_prod = βΉcf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β (-,set {b})β©Cβ©FβΊ
note [cat_cs_simps] = set_empty
interpret cf_prod: is_functor
Ξ± βΉcat_Rel Ξ± Γβ©C cat_Rel Ξ±βΊ βΉcat_Rel Ξ±βΊ βΉcf_prod_2_Rel (cat_Rel Ξ±)βΊ
by (cs_concl cs_intro: cat_cs_intros cat_Rel_cs_intros)
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence (Mr_Rel (cat_Rel Ξ±) b)" unfolding Mr_Rel_def by auto
show "vcard (Mr_Rel (cat_Rel Ξ±) b) = 5β©β"
unfolding Mr_Rel_def by (simp add: nat_omega_simps)
from assms show "?cf_prod : cat_Rel Ξ± β¦β¦β©CβΞ±β cat_Rel Ξ±"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_cs_intros V_cs_intros
)
show "Mr_Rel (cat_Rel Ξ±) bβ¦NTMapβ¦β¦Bβ¦ :
?cf_prodβ¦ObjMapβ¦β¦Bβ¦ β¦β©iβ©sβ©oβcat_Rel Ξ±β cf_id (cat_Rel Ξ±)β¦ObjMapβ¦β¦Bβ¦"
if "B ββ©β cat_Rel Ξ±β¦Objβ¦" for B
using assms that
by
(
cs_concl
cs_simp: cat_Rel_components(1) V_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros
cat_Rel_par_set_cs_intros
V_cs_intros
cat_prod_cs_intros
)
with cat_Rel_is_arr_isomorphismD[OF this] show
"Mr_Rel (cat_Rel Ξ±) bβ¦NTMapβ¦β¦Bβ¦ :
?cf_prodβ¦ObjMapβ¦β¦Bβ¦ β¦βcat_Rel Ξ±β cf_id (cat_Rel Ξ±)β¦ObjMapβ¦β¦Bβ¦"
if "B ββ©β cat_Rel Ξ±β¦Objβ¦" for B
using that by simp
show
"Mr_Rel (cat_Rel Ξ±) bβ¦NTMapβ¦β¦Bβ¦ ββ©Aβcat_Rel Ξ±β ?cf_prodβ¦ArrMapβ¦β¦Fβ¦ =
cf_id (cat_Rel Ξ±)β¦ArrMapβ¦β¦Fβ¦ ββ©Aβcat_Rel Ξ±β Mr_Rel (cat_Rel Ξ±) bβ¦NTMapβ¦β¦Aβ¦"
if "F : A β¦βcat_Rel Ξ±β B" for A B F
proof-
note F = cat_Rel_is_arrD[OF that]
interpret F: arr_Rel Ξ± F
rewrites "Fβ¦ArrDomβ¦ = A" and "Fβ¦ArrCodβ¦ = B"
by (intro F)+
have [cat_cs_simps]:
"vfst_arrow B (set {b}) ββ©Aβcat_Rel Ξ±β
prod_2_Rel F (cat_Rel Ξ±β¦CIdβ¦β¦set {b}β¦) =
F ββ©Aβcat_Rel Ξ±β vfst_arrow A (set {b})"
(is βΉ?B1 ββ©Aβcat_Rel Ξ±β ?bF = F ββ©Aβcat_Rel Ξ±β ?A1βΊ)
proof-
from assms that have lhs:
"?B1 ββ©Aβcat_Rel Ξ±β ?bF : A Γβ©β set {b} β¦βcat_Rel Ξ±β B"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
)
from assms that have rhs:
"F ββ©Aβcat_Rel Ξ±β ?A1 : A Γβ©β set {b} β¦βcat_Rel Ξ±β B"
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
)
have [cat_cs_simps]:
"?B1β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (Fβ¦ArrValβ¦) (vid_on (set {b})) =
Fβ¦ArrValβ¦ ββ©β ?A1β¦ArrValβ¦"
proof(intro vsubset_antisym vsubsetI)
fix xx'_z assume "xx'_z ββ©β
?B1β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (Fβ¦ArrValβ¦) (vid_on (set {b}))"
then obtain xx' yy' z
where xx'_z_def: "xx'_z = β¨xx', zβ©"
and xx'_yy':
"β¨xx', yy'β© ββ©β prod_2_Rel_ArrVal (Fβ¦ArrValβ¦) (vid_on (set {b}))"
and yy'_z: "β¨yy', zβ© ββ©β ?B1β¦ArrValβ¦"
by auto
from xx'_yy' obtain x x' y y'
where "β¨xx', yy'β© = β¨β¨x, x'β©, β¨y, y'β©β©"
and "β¨x', y'β© ββ©β vid_on (set {b})"
and xy: "β¨x, yβ© ββ©β Fβ¦ArrValβ¦"
by auto
then have xx'_def: "xx' = β¨x, bβ©" and yy'_def: "yy' = β¨y, bβ©"
by simp_all
with yy'_z have y': "y ββ©β B" and z_def: "z = y"
unfolding vfst_arrow_components by auto
from xy vsubsetD have x: "x ββ©β A"
by (auto intro: F.arr_Rel_ArrVal_vdomain)
show "xx'_z ββ©β Fβ¦ArrValβ¦ ββ©β ?A1β¦ArrValβ¦"
unfolding xx'_z_def z_def xx'_def
by (intro vcompI, rule xy)
(auto simp: vfst_arrow_components x VLambda_iff2)
next
fix xy_z assume "xy_z ββ©β Fβ¦ArrValβ¦ ββ©β ?A1β¦ArrValβ¦"
then obtain xy y z
where xx'_z_def: "xy_z = β¨xy, zβ©"
and xy_y: "β¨xy, yβ© ββ©β ?A1β¦ArrValβ¦"
and yz[cat_cs_intros]: "β¨y, zβ© ββ©β Fβ¦ArrValβ¦"
by auto
then have xy_z_def: "xy_z = β¨β¨y, bβ©, zβ©"
and y: "y ββ©β A"
and xy_def: "xy = β¨y, bβ©"
unfolding vfst_arrow_components by auto
from yz vsubsetD have z: "z ββ©β B"
by (auto intro: F.arr_Rel_ArrVal_vrange)
have [cat_cs_intros]: "β¨b, bβ© ββ©β vid_on (set {b})" by auto
show "xy_z ββ©β
?B1β¦ArrValβ¦ ββ©β prod_2_Rel_ArrVal (Fβ¦ArrValβ¦) (vid_on (set {b}))"
unfolding xy_z_def
by
(
intro vcompI prod_2_Rel_ArrValI,
rule vsv.vsv_ex1_app1[THEN iffD1],
unfold cat_cs_simps,
insert z
)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
)
qed
show ?thesis
proof(rule arr_Rel_eqI)
from lhs show arr_Rel_lhs: "arr_Rel Ξ± (?B1 ββ©Aβcat_Rel Ξ±β ?bF)"
by (auto dest: cat_Rel_is_arrD)
from rhs show "arr_Rel Ξ± (F ββ©Aβcat_Rel Ξ±β ?A1)"
by (auto dest: cat_Rel_is_arrD)
note cat_Rel_CId_app[cat_Rel_cs_simps del]
note π΅.cat_Rel_CId_app[cat_Rel_cs_simps del]
from that assms show
"(?B1 ββ©Aβcat_Rel Ξ±β ?bF)β¦ArrValβ¦ = (F ββ©Aβcat_Rel Ξ±β ?A1)β¦ArrValβ¦"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps
cs_intro: cat_cs_intros cat_Rel_par_set_cs_intros V_cs_intros
cs_simp:
id_Rel_components
cat_Rel_CId_app
comp_Rel_components(1)
prod_2_Rel_components
cat_Rel_components(1)
)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from that assms show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros V_cs_intros cat_prod_cs_intros
cs_simp: cat_Rel_components(1) V_cs_simps
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
qed
lemma (in π΅) Mr_Rel_is_iso_ntcf'[cat_cs_intros]:
assumes "b ββ©β cat_Rel Ξ±β¦Objβ¦"
and "π' = cf_prod_2_Rel (cat_Rel Ξ±)βcat_Rel Ξ±,cat_Rel Ξ±β(-,set {b})β©Cβ©F"
and "π' = cf_id (cat_Rel Ξ±)"
and "π' = cat_Rel Ξ±"
and "π
' = cat_Rel Ξ±"
and "Ξ±' = Ξ±"
shows "Mr_Rel (cat_Rel Ξ±) b : π' β¦β©Cβ©Fβ©.β©iβ©sβ©o π' : π' β¦β¦β©CβΞ±β π
'"
using assms(1) unfolding assms(2-6) by (rule Mr_Rel_is_iso_ntcf)
lemmas [cat_cs_intros] = π΅.Mr_Rel_is_iso_ntcf'
subsectionβΉβΉRelβΊ as a monoidal categoryβΊ
subsubsectionβΉDefinition and elementary propertiesβΊ
textβΉ
For further information see
\cite{noauthor_wikipedia_2001}\footnote{\url{
https://en.wikipedia.org/wiki/Category_of_relations
}}.
βΊ
definition mcat_Rel :: "V β V β V"
where "mcat_Rel Ξ± a =
[
cat_Rel Ξ±,
cf_prod_2_Rel (cat_Rel Ξ±),
set {a},
MΞ±_Rel (cat_Rel Ξ±),
Ml_Rel (cat_Rel Ξ±) a,
Mr_Rel (cat_Rel Ξ±) a
]β©β"
textβΉComponents.βΊ
lemma mcat_Rel_components:
shows "mcat_Rel Ξ± aβ¦Mcatβ¦ = cat_Rel Ξ±"
and "mcat_Rel Ξ± aβ¦Mcfβ¦ = cf_prod_2_Rel (cat_Rel Ξ±)"
and "mcat_Rel Ξ± aβ¦Meβ¦ = set {a}"
and "mcat_Rel Ξ± aβ¦MΞ±β¦ = MΞ±_Rel (cat_Rel Ξ±)"
and "mcat_Rel Ξ± aβ¦Mlβ¦ = Ml_Rel (cat_Rel Ξ±) a"
and "mcat_Rel Ξ± aβ¦Mrβ¦ = Mr_Rel (cat_Rel Ξ±) a"
unfolding mcat_Rel_def mcat_field_simps by (simp_all add: nat_omega_simps)
subsubsectionβΉβΉRelβΊ is a monoidal categoryβΊ
lemma (in π΅)
assumes "a ββ©β cat_Rel Ξ±β¦Objβ¦"
shows "monoidal_category Ξ± (mcat_Rel Ξ± a)"
proof-
interpret Set_Par: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Par Ξ±βΊ
by (rule wide_replete_subcategory_cat_Set_cat_Par)
interpret Par_Rel: wide_replete_subcategory Ξ± βΉcat_Par Ξ±βΊ βΉcat_Rel Ξ±βΊ
by (rule wide_replete_subcategory_cat_Par_cat_Rel)
interpret Set_Rel: wide_replete_subcategory Ξ± βΉcat_Set Ξ±βΊ βΉcat_Rel Ξ±βΊ
by
(
rule wr_subcat_trans
[
OF
Set_Par.wide_replete_subcategory_axioms
Par_Rel.wide_replete_subcategory_axioms
]
)
show ?thesis
proof(rule monoidal_categoryI)
show "vfsequence (mcat_Rel Ξ± a)" unfolding mcat_Rel_def by auto
show "category Ξ± (mcat_Rel Ξ± aβ¦Mcatβ¦)"
unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
show "mcat_Rel Ξ± aβ¦Mcfβ¦ :
mcat_Rel Ξ± aβ¦Mcatβ¦ Γβ©C mcat_Rel Ξ± aβ¦Mcatβ¦ β¦β¦β©CβΞ±β mcat_Rel Ξ± aβ¦Mcatβ¦"
unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
show "mcat_Rel Ξ± aβ¦MΞ±β¦ :
cf_blcomp (mcat_Rel Ξ± aβ¦Mcfβ¦) β¦β©Cβ©Fβ©.β©iβ©sβ©o cf_brcomp (mcat_Rel Ξ± aβ¦Mcfβ¦) :
mcat_Rel Ξ± aβ¦Mcatβ¦^β©Cβ©3 β¦β¦β©CβΞ±β mcat_Rel Ξ± aβ¦Mcatβ¦"
unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
from assms show "mcat_Rel Ξ± aβ¦Mlβ¦ :
mcat_Rel Ξ± aβ¦Mcfβ¦βmcat_Rel Ξ± aβ¦Mcatβ¦,mcat_Rel Ξ± aβ¦Mcatβ¦β (mcat_Rel Ξ± aβ¦Meβ¦,-)β©Cβ©F
β¦β©Cβ©Fβ©.β©iβ©sβ©o
cf_id (mcat_Rel Ξ± aβ¦Mcatβ¦) :
mcat_Rel Ξ± aβ¦Mcatβ¦ β¦β¦β©CβΞ±β mcat_Rel Ξ± aβ¦Mcatβ¦"
unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
from assms show "mcat_Rel Ξ± aβ¦Mrβ¦ :
mcat_Rel Ξ± aβ¦Mcfβ¦βmcat_Rel Ξ± aβ¦Mcatβ¦,mcat_Rel Ξ± aβ¦Mcatβ¦β (-,mcat_Rel Ξ± aβ¦Meβ¦)β©Cβ©F
β¦β©Cβ©Fβ©.β©iβ©sβ©o
cf_id (mcat_Rel Ξ± aβ¦Mcatβ¦) : mcat_Rel Ξ± aβ¦Mcatβ¦ β¦β¦β©CβΞ±β mcat_Rel Ξ± aβ¦Mcatβ¦"
unfolding mcat_Rel_components by (cs_concl cs_intro: cat_cs_intros)
show "vcard (mcat_Rel Ξ± a) = 6β©β"
unfolding mcat_Rel_def by (simp add: nat_omega_simps)
from assms show "mcat_Rel Ξ± aβ¦Meβ¦ ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦"
unfolding mcat_Rel_components cat_Rel_components by force
show
"mcat_Rel Ξ± aβ¦Mcatβ¦β¦CIdβ¦β¦Aβ¦ ββ©Hβ©Mβ©.β©Aβmcat_Rel Ξ± aβ¦Mcfβ¦β
mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦B, C, Dβ¦β©β ββ©Aβmcat_Rel Ξ± aβ¦Mcatβ¦β
mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦
A, B ββ©Hβ©Mβ©.β©Oβmcat_Rel Ξ± aβ¦Mcfβ¦β C, D
β¦β©β ββ©Aβmcat_Rel Ξ± aβ¦Mcatβ¦β
(mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦A, B, Cβ¦β©β ββ©Hβ©Mβ©.β©Aβmcat_Rel Ξ± aβ¦Mcfβ¦β
mcat_Rel Ξ± aβ¦Mcatβ¦β¦CIdβ¦β¦Dβ¦) =
mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦
A, B, C ββ©Hβ©Mβ©.β©Oβmcat_Rel Ξ± aβ¦Mcfβ¦β D
β¦β©β ββ©Aβmcat_Rel Ξ± aβ¦Mcatβ¦β
mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦A ββ©Hβ©Mβ©.β©Oβmcat_Rel Ξ± aβ¦Mcfβ¦β B, C, Dβ¦β©β"
if "A ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦"
and "B ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦"
and "C ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦"
and "D ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦"
for A B C D
proof-
have [cat_cs_simps]:
"prod_2_Rel (cat_Rel Ξ±β¦CIdβ¦β¦Aβ¦) (MΞ±_Rel_arrow_lr B C D) ββ©Aβcat_Rel Ξ±β
(
MΞ±_Rel_arrow_lr A (B Γβ©β C) D ββ©Aβcat_Rel Ξ±β
prod_2_Rel (MΞ±_Rel_arrow_lr A B C) (cat_Rel Ξ±β¦CIdβ¦β¦Dβ¦)
) =
MΞ±_Rel_arrow_lr A B (C Γβ©β D) ββ©Aβcat_Rel Ξ±β
MΞ±_Rel_arrow_lr (A Γβ©β B) C D"
(
is
βΉ
?A_BCD ββ©Aβcat_Rel Ξ±β (?A_BC_D ββ©Aβcat_Rel Ξ±β ?ABC_D) =
?A_B_CD ββ©Aβcat_Rel Ξ±β ?AB_C_D
βΊ
)
proof-
have [cat_cs_simps]:
"prod_2_Rel (cat_Set Ξ±β¦CIdβ¦β¦Aβ¦) (MΞ±_Rel_arrow_lr B C D) ββ©Aβcat_Set Ξ±β
(
?A_BC_D ββ©Aβcat_Set Ξ±β
prod_2_Rel (MΞ±_Rel_arrow_lr A B C) (cat_Set Ξ±β¦CIdβ¦β¦Dβ¦)
) = ?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D"
(
is
βΉ
?A_BCD ββ©Aβcat_Set Ξ±β (?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D) =
?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D
βΊ
)
proof-
from that have lhs:
"?A_BCD ββ©Aβcat_Set Ξ±β (?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D) :
((A Γβ©β B) Γβ©β C) Γβ©β D β¦βcat_Set Ξ±β A Γβ©β B Γβ©β C Γβ©β D"
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp: cat_Set_components(1)
cs_intro: cat_rel_par_Set_cs_intros cat_cs_intros V_cs_intros
)
then have dom_lhs:
"πβ©β ((?A_BCD ββ©Aβcat_Set Ξ±β (?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D))β¦ArrValβ¦) =
((A Γβ©β B) Γβ©β C) Γβ©β D"
by (cs_concl cs_simp: cat_cs_simps)
from that have rhs: "?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D :
((A Γβ©β B) Γβ©β C) Γβ©β D β¦βcat_Set Ξ±β A Γβ©β B Γβ©β C Γβ©β D"
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_Set_components(1)
cs_intro:
cat_cs_intros V_cs_intros MΞ±_Rel_arrow_lr_is_cat_Set_arr'
)
then have dom_rhs:
"πβ©β ((?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D)β¦ArrValβ¦) =
((A Γβ©β B) Γβ©β C) Γβ©β D"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs:
"arr_Set Ξ± (?A_BCD ββ©Aβcat_Set Ξ±β (?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D))"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs:
"arr_Set Ξ± (?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?A_BCD ββ©Aβcat_Set Ξ±β (?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D))β¦ArrValβ¦ =
(?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D)β¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix abcd assume prems: "abcd ββ©β ((A Γβ©β B) Γβ©β C) Γβ©β D"
then obtain a b c d
where abcd_def: "abcd = β¨β¨β¨a, bβ©, cβ©, dβ©"
and a: "a ββ©β A"
and b: "b ββ©β B"
and c: "c ββ©β C"
and d: "d ββ©β D"
by clarsimp
from that prems a b c d show
"(
?A_BCD ββ©Aβcat_Set Ξ±β
(?A_BC_D ββ©Aβcat_Set Ξ±β ?ABC_D)
)β¦ArrValβ¦β¦abcdβ¦ =
(?A_B_CD ββ©Aβcat_Set Ξ±β ?AB_C_D)β¦ArrValβ¦β¦abcdβ¦"
unfolding abcd_def mcat_Rel_components(1) cat_Rel_components(1)
by
(
cs_concl
cs_simp:
cat_Set_components(1)
cat_cs_simps
cat_rel_par_Set_cs_simps
cs_intro:
cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from assms that show ?thesis
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Rel_components(1)
cat_Set_components(1)
Set_Rel.subcat_CId[symmetric]
Set_Rel.subcat_Comp_simp[symmetric]
cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
)+
qed
from that show ?thesis
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp: cat_Rel_components(1) cat_cs_simps
cs_intro:
cat_cs_intros
cat_Rel_par_set_cs_intros
V_cs_intros
cat_prod_cs_intros
)
qed
show
"mcat_Rel Ξ± aβ¦Mcatβ¦β¦CIdβ¦β¦Aβ¦ ββ©Hβ©Mβ©.β©Aβmcat_Rel Ξ± aβ¦Mcfβ¦β
mcat_Rel Ξ± aβ¦Mlβ¦β¦NTMapβ¦β¦Bβ¦ ββ©Aβmcat_Rel Ξ± aβ¦Mcatβ¦β
mcat_Rel Ξ± aβ¦MΞ±β¦β¦NTMapβ¦β¦A, mcat_Rel Ξ± aβ¦Meβ¦, Bβ¦β©β =
mcat_Rel Ξ± aβ¦Mrβ¦β¦NTMapβ¦β¦Aβ¦ ββ©Hβ©Mβ©.β©Aβmcat_Rel Ξ± aβ¦Mcfβ¦β
mcat_Rel Ξ± aβ¦Mcatβ¦β¦CIdβ¦β¦Bβ¦"
if "A ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦" and "B ββ©β mcat_Rel Ξ± aβ¦Mcatβ¦β¦Objβ¦" for A B
proof-
note [cat_cs_simps] = set_empty
have [cat_cs_simps]:
"prod_2_Rel (cat_Set Ξ±β¦CIdβ¦β¦Aβ¦) (vsnd_arrow (set {a}) B) ββ©Aβcat_Set Ξ±β
MΞ±_Rel_arrow_lr A (set {a}) B =
prod_2_Rel (vfst_arrow A (set {a})) (cat_Set Ξ±β¦CIdβ¦β¦Bβ¦)"
(is βΉ?A_aB ββ©Aβcat_Set Ξ±β ?AaB = ?Aa_BβΊ)
proof-
from assms that have lhs:
"?A_aB ββ©Aβcat_Set Ξ±β ?AaB : (A Γβ©β set {a}) Γβ©β B β¦βcat_Set Ξ±β A Γβ©β B"
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_components(1) cat_Set_components(1)
cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
)
then have dom_lhs:
"πβ©β ((?A_aB ββ©Aβcat_Set Ξ±β ?AaB)β¦ArrValβ¦) = (A Γβ©β set {a}) Γβ©β B"
by (cs_concl cs_simp: cat_cs_simps)
from assms that have rhs:
"?Aa_B : (A Γβ©β set {a}) Γβ©β B β¦βcat_Set Ξ±β A Γβ©β B"
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
)
then have dom_rhs: "πβ©β (?Aa_Bβ¦ArrValβ¦) = (A Γβ©β set {a}) Γβ©β B"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs: "arr_Set Ξ± (?A_aB ββ©Aβcat_Set Ξ±β ?AaB)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs: "arr_Set Ξ± ?Aa_B"
by (auto dest: cat_Set_is_arrD(1))
show "(?A_aB ββ©Aβcat_Set Ξ±β ?AaB)β¦ArrValβ¦ = ?Aa_Bβ¦ArrValβ¦"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix xay assume "xay ββ©β (A Γβ©β set {a}) Γβ©β B"
then obtain x y
where xay_def: "xay = β¨β¨x, aβ©, yβ©" and x: "x ββ©β A" and y: "y ββ©β B"
by auto
from assms that x y show
"(?A_aB ββ©Aβcat_Set Ξ±β ?AaB)β¦ArrValβ¦β¦xayβ¦ = ?Aa_Bβ¦ArrValβ¦β¦xayβ¦"
unfolding xay_def mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp:
cat_Rel_components(1) cat_Set_components(1)
cat_cs_simps cat_rel_par_Set_cs_simps
cs_intro:
cat_cs_intros cat_rel_par_Set_cs_intros V_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in βΉcs_concl cs_simp: cat_cs_simpsβΊ)+
qed
from assms that show ?thesis
unfolding mcat_Rel_components cat_Rel_components(1)
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Rel_components(1)
cat_Set_components(1)
Set_Rel.subcat_CId[symmetric]
Set_Rel.subcat_Comp_simp[symmetric]
cs_intro:
cat_cs_intros
cat_rel_par_Set_cs_intros
V_cs_intros
cat_prod_cs_intros
Set_Rel.subcat_is_arrD
)
qed
qed auto
qed
textβΉ\newpageβΊ
end